untfunctions.pas

一个有关Delphi 中 UDP协议的实列

procedure DeBug(ICon: Variant);
var
  LStr: string;
begin
  if ShowDeBug then begin
    LStr := ICon;
    OutputDebugString(PChar(LStr));
  end;
end;

procedure DeBug(ICon: string; const Args: array of const);
begin
  if ShowDeBug then
    OutputDebugString(PChar(Format(ICon, Args)));
end;

{-------------------------------------------------------------------------------
  过程名:    IsNullBackStr
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Ivar: Variant
  返回值:    string
  说明:
-------------------------------------------------------------------------------}
{$ENDIF}

{$IFDEF List}
{-------------------------------------------------------------------------------
  过程名:    GetObj
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Ilist: TStrings; Iidx: Integer
  返回值:    TObject
  说明:
-------------------------------------------------------------------------------}

function GetObj(Ilist: TStrings; Iidx: Integer): TObject;
begin
  Result := Ilist.Objects[Iidx];
end;

{-------------------------------------------------------------------------------
  过程名:    AddList
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Ilist: Tstrings; ICapTion: string; Iobj: Tobject
  返回值:    无
  说明:
-------------------------------------------------------------------------------}

procedure AddList(Ilist: Tstrings; ICapTion: string; Iobj: Tobject);
begin
  Ilist.AddObject(ICapTion, Iobj);
end;

{-------------------------------------------------------------------------------
  过程名:    ClearList
  作者:      马敏钊
  日期:      2006.01.06
  参数:      IList: TStrings
  返回值:    无
  说明:
-------------------------------------------------------------------------------}

procedure ClearList(IList: TStrings);
var
  i: Integer;
begin
  for I := 0 to IList.Count - 1 do
    IList.Objects[i].free;
  IList.Clear;
end;

{-------------------------------------------------------------------------------
  过程名:    GetOnlyFileName
  作者:      马敏钊
  日期:      2006.01.06
  参数:      IfileName:String
  返回值:    string
  说明:      获取文件名称 不带路径和后缀
-------------------------------------------------------------------------------}

function GetOnlyFileName(IfileName: string): string;
var
  Tmp, Ext: string;
begin
  Tmp := ExtractFileName(IfileName);
  Ext := ExtractFileExt(IfileName);
  Result := copy(Tmp, 1, Length(Tmp) - Length(Ext));
end;

{-------------------------------------------------------------------------------
  过程名:    GetEveryWord
  作者:      马敏钊
  日期:      2006.01.06
  参数:      S: string; E: TStringList; C: string
  返回值:    无
  说明:      分割字符串 返回的StringList由外部自己管理内存
-------------------------------------------------------------------------------}

procedure GetEveryWord(S: string; E: TStrings; C: string);
var
  t, a: string;
begin
  t := s;
  while Pos(c, t) > 0 do begin
    a := copy(t, 1, pos(c, t) - 1);
    t := copy(t, pos(c, t) + 1, length(t) - pos(c, t));
    e.Add(a);
  end;
  if Trim(t) <> '' then e.Add(t);
end;

{-------------------------------------------------------------------------------
  过程名:    FindFileList
  作者:      马敏钊
  日期:      2006.01.16
  参数:      path:路径, filter:文件扩展名过滤, FileList:文件列表, ContainSubDir:是否包含子目录
  返回值:    无
  说明:     查找一个路径下的所有文件。
-------------------------------------------------------------------------------}

procedure FindFileList(Path, Filter: string; FileList: TStrings; ContainSubDir: Boolean);
var
  FSearchRec, DSearchRec: TSearchRec;
  FindResult: Cardinal;
begin
  FindResult := FindFirst(path + Filter, sysutils.faAnyFile, FSearchRec);
  try
    while FindResult = 0 do begin
      FileList.Add(FSearchRec.Name);
      FindResult := FindNext(FSearchRec);
    end;
    if ContainSubDir then begin
      FindResult := FindFirst(path + Filter, faDirectory, DSearchRec);
      while FindResult = 0 do begin
        if ((DSearchRec.Attr and faDirectory) = faDirectory)
          and (DSearchRec.Name <> '.') and (DSearchRec.Name <> '..') then
          FindFileList(Path, Filter, FileList, ContainSubDir);
        FindResult := FindNext(DSearchRec);
      end;
    end;
  finally
    FindClose(FindResult);
  end;
end;
{$ENDIF}


{$IFDEF db}

function IsNullReturnStr(Ivar: Variant): string;
begin
  if VarIsNull(Ivar) then
    Result := ''
  else
    Result := Ivar;
end;

{-------------------------------------------------------------------------------
  过程名:    IsNullBackFloat
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Ivar: Variant
  返回值:    Double
  说明:
-------------------------------------------------------------------------------}

function IsNullReturnFloat(Ivar: Variant): Double;
begin
  if VarIsNull(Ivar) then
    Result := 0
  else
    Result := Ivar;
end;

{-------------------------------------------------------------------------------
  过程名:    IsNullBackint
  作者:      马敏钊
  日期:      2006.01.06
  参数:      Ivar: Variant
  返回值:    Integer
  说明:
-------------------------------------------------------------------------------}

function IsNullReturnint(Ivar: Variant): Integer;
begin
  if VarIsNull(Ivar) then
    Result := 0
  else
    Result := Ivar;
end;



{ TBaseDbMrg }

constructor TDBMrg.Create(IConStr: string; ICreateBuffCount: Integer = 5);
var
  I: Integer;
begin
  FName := 0;
  FTotCount := 100;
  FAutoFreeConn := True;
  FConn := TADOConnection.Create(nil);
  FConn.LoginPrompt := False;
  FPool := TStringList.Create;
  FConn.ConnectionString := IConStr;
  FConn.Connected := True;
  for I := 0 to ICreateBuffCount do
    GetAnQuery();
  FThread_Check := TCheckThread.Create(False, Self);
end;

constructor TDBMrg.Create(IConn: TADOConnection; ICreateBuffCount: Integer = 5);
var
  I: Integer;
begin
  FName := 0;
  FTotCount := 100;
  FConn := IConn;
  if IConn <> nil then
    FConn.LoginPrompt := False;
  FAutoFreeConn := False;
  FPool := TStringList.Create;
  for I := 0 to ICreateBuffCount - 1 do
    GetAnQuery();
  FThread_Check := TCheckThread.Create(False, Self);
end;

destructor TDBMrg.Destroy;
var
  I: Integer;
begin
  FThread_Check.Terminate;
  if FAutoFreeConn then
    FConn.Free;
  for I := 0 to FPool.Count - 1 do
    FPool.Objects[i].Free;
  FPool.Free;
  inherited;
end;

{-------------------------------------------------------------------------------
  过程名:    TDBMrg.AddAnOutAdo
  作者:      马敏钊
  日期:      2006.01.11
  参数:      Iado: TADOQuery
  返回值:    无
  说明:      加入一个由外部创建的ADO 帮它管理生命周期和重用
-------------------------------------------------------------------------------}

procedure TDBMrg.AddAnOutAdo(Iado: TADOQuery);
begin
  Iado.Close;
  Iado.Connection := FConn;
  if PoolCount + 1 > FTotCount then raise Exception.Create('已经达到最大限度不允许在添加新的QUERY');
  Iado.Tag := FPool.AddObject(CDb_State_NoneUsed, Iado);
end;

{-------------------------------------------------------------------------------
  过程名:    TDBMrg.BackToPool
  作者:      马敏钊
  日期:      2006.01.11
  参数:      Iado: TADOQuery
  返回值:    无
  说明:     释放ADO使用权以便其它人员使用
-------------------------------------------------------------------------------}

procedure TDBMrg.BackToPool(IName: string);
var
  I: Integer;
begin
  for I := 0 to FPool.Count - 1 do begin // Iterate
    if TADOQuery(FPool.Objects[i]).Name = IName then begin
      FPool.Strings[i] := CDb_State_NoneUsed;
    end;
  end; // for
end;

procedure TDBMrg.BackToPool(Iado: TADOQuery);
begin
  if Iado = nil then Exit;
  try
    FPool.Strings[Iado.Tag] := CDb_State_NoneUsed;
  except
    raise Exception.Create('回归Adoquery的时候异常 Tag属性被改变');
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    TDBMrg.DeleteSomeThing
  作者:      马敏钊
  日期:      2006.01.11
  参数:      ItabName, IFieldName: string; Ivalue: Variant
  返回值:    无
  说明:     根据字段名和值删除表内容
-------------------------------------------------------------------------------}

procedure TDBMrg.DeleteSomeThing(ItabName, IFieldName: string;
  Ivalue: Variant);
begin
  with GetAnQuery(CDb_State_CanUsed) do begin
    try
      Close;
      SQL.Text := Format('Delete from %s where %s=:VarIant', [ItabName, IFieldName]);
      Parameters.ParamValues['VarIant'] := Ivalue;
      ExecSQL;
    finally
      Close;
    end;
  end; // with
end;

{-------------------------------------------------------------------------------
  过程名:    TDBMrg.ExecAnSql
  作者:      马敏钊
  日期:      2006.01.11
  参数:      Isql: string
  返回值:    Integer
  说明:      执行一个语句
-------------------------------------------------------------------------------}

function TDBMrg.ExecAnSql(Isql: string): Integer;
begin
  with GetAnQuery do begin
    try
      Close;
      SQL.Text := Isql;
      Result := ExecSQL;
    finally // wrap up
      Close;
    end; // try/finally
  end; // with
end;

{-------------------------------------------------------------------------------
  过程名:    TDBMrg.GetAnQuery
  作者:      马敏钊
  日期:      2006.01.11
  参数:      Iname: string
  返回值:    TADOQuery
  说明:获取一个ADO对象 可以指定名字 如果没有名字 系统自己返回一合适的对象
-------------------------------------------------------------------------------}

function TDBMrg.GetAnQuery(Iname: string): TADOQuery;
var
  I: Integer;
begin
  Result := nil;
  if PoolCount > FTotCount then begin
    raise Exception.Create('AdoQuery已经达到最大限制数量！缓冲池不允许再添加新对象' + #13
      + '请检查是否由于忘记回归ADOQUERY所导致');
    Exit;
  end;
  if Iname <> '' then begin
    for I := 0 to FPool.Count - 1 do
      if (FPool.Objects[i] as TADOQuery).Name = 'MyPool' + Iname then begin
        Result := FPool.Objects[i] as TADOQuery;
        Exit;
      end;
    Result := TADOQuery.Create(nil);
    Result.Connection := FConn;
    Result.Name := 'MyPool' + Iname;
    Result.Tag := FPool.AddObject(IntToStr(CDb_State_EverUsed), Result);
  end;
end;


function TDBMrg.GetAnQuery(IuserTime: integer = 1; Iname: string = ''):
  TADOQuery;
var
  I: Integer;
  LState: string;
begin
  if IuserTime = CDb_State_CanUsed then
    LState := ''
  else
    LState := IntToStr(IuserTime);
  if PoolCount > FTotCount then begin
    raise Exception.Create('AdoQuery已经达到最大限制数量！缓冲池不允许再添加新对象' + #13
      + '请检查是否由于忘记回归ADOQUERY所导致');
    Exit;
  end;
  if Iname <> '' then begin
    for I := 0 to FPool.Count - 1 do
      if (FPool.Objects[i] as TADOQuery).Name = 'MyPool' + Iname then begin
        Result := FPool.Objects[i] as TADOQuery;
        FPool.Strings[i] := LState;
        Exit;
      end;
    Result := TADOQuery.Create(nil);
    Result.Connection := FConn;
    Result.Name := 'MyPool' + Iname;
    Result.Tag := FPool.AddObject(IntToStr(CDb_State_EverUsed), Result);
  end
  else begin
    for I := 0 to FPool.Count - 1 do begin // Iterate
      if (FPool.Strings[i] = CDb_State_NoneUsed) then begin
        Result := FPool.Objects[i] as TADOQuery;
        FPool.Strings[i] := LState;
        Exit;
      end;
    end; // for
    Result := TADOQuery.Create(nil);
    Result.Connection := FConn;
    Inc(FName);
    Result.Name := 'MyPool' + IntToStr(FName);
    Result.Tag := FPool.AddObject(LState, Result);
  end;
end;

{-------------------------------------------------------------------------------
  过程名:    TDBMrg.GetConn
  作者:      马敏钊
  日期:      2006.01.11
  参数:      无
  返回值:    TADOConnection
  说明:      获取连接
-------------------------------------------------------------------------------}

function TDBMrg.GetConn: TADOConnection;
begin
  Result := FConn;
end;

{-------------------------------------------------------------------------------
  过程名:    TDBMrg.GetCount
  作者:      马敏钊
  日期:      2006.01.11
  参数:      ItabName, IFieldName: string; Ivalue: variant
  返回值:    Integer
  说明:      获取符合记录的个数
-------------------------------------------------------------------------------}

function TDBMrg.GetCount(ItabName, IFieldName: string; Ivalue: variant):
  Cardinal;
begin
  with GetAnQuery do begin
    Close;
    SQL.Text := Format('Select Count(%s) as MyCount from %s where %s=:variant',
      [IFieldName, ItabName, IFieldName]);
    Parameters.ParamValues['VarIant'] := Ivalue;
    try
      Open;
      Result := Fieldbyname('MyCount').AsInteger;
    except
      Result := 0;