?? untfunctions.pas

?? 通訊過程中需要某些重要的命令不丟失
?? PAS
?? 第 1 頁 / 共 4 頁
字號:

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;
?? 文件大小 716 K
?? 上傳用戶 wang8310733
?? 所屬分類 Delphi控件源碼
??? 相關標簽

#通訊 #過程 #命令
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? untfunctions.pas

?? 快捷鍵說明
