pubfuns.pas

极具实用价值的文件管理系统

             const KeyFields: String = '';
             const KeyValues: String = '';
             const OrderFields: String = ''
  Result:    String
  Author:    Cyclone
  Date:      2005-3-11 13:13:09

-----------------------------------------------------------------------------}
function FormatSQL(const TableName, SelFields: String; const KeyFields: String = '';
  const KeyValues: String = ''; const OrderFields: String = ''): String;
var
  SelFieldList,
  KeyFieldList,
  KeyValueList,
  OrderFieldList,
  WhereClause: String;
begin
  SelFieldList := Trim(AnsiReplaceStr(SelFields, ';', ','));
  if RightStr(SelFieldList, 1) = ',' then
    SelFieldList := LeftStr(SelFieldList, Length(SelFieldList) - 1);
  if SelFieldList = '' then
    SelFieldList := ' * ';
  Result := 'SELECT ' + SelFieldList + ' FROM ' + TableName;

  KeyFieldList := GetAddSeparaterStr(';', KeyFields);
  if KeyFieldList <> '' then
  begin
    KeyValueList := GetAddSeparaterStr(';', KeyValues);
    while Pos(';', KeyFieldList) > 0 do
    begin
      AddSeparater(' AND ', WhereClause);
      WhereClause := WhereClause + LeftStr(KeyFieldList, Pos(';', KeyFieldList) - 1) + ' = ' +
                     QuotedStr(LeftStr(KeyValueList, Pos(';', KeyValueList)- 1));
      System.Delete(KeyFieldList, 1, Pos(';', KeyFieldList));
      System.Delete(KeyValueList, 1, Pos(';', KeyValueList));
    end;
  end;
  if WhereClause <> '' then
    Result := Result + ' WHERE ' + WhereClause;

  OrderFieldList := IfThen(Trim(OrderFields) = '', AnsiReplaceStr(KeyFields, ';', ','),
    AnsiReplaceStr(OrderFields, ';', ','));
  if RightStr(OrderFieldList, 1) = ',' then
    OrderFieldList := LeftStr(OrderFieldList, Length(OrderFieldList) - 1);
  if OrderFieldList <> '' then
    Result := Result + ' ORDER BY ' + OrderFieldList;
end;

{-----------------------------------------------------------------------------
  Procedure: GetFieldValue
  Purpose:   Get A Field Value
  Arguments: const TableName, SelFields: String;
             const KeyFields: String = '';
             const KeyValues: String = ''
  Result:    Variant
  Author:    Cyclone
  Date:      2005-3-11 13:12:54

-----------------------------------------------------------------------------}
function GetFieldValue(const TableName, SelFields: String; const KeyFields: String = '';
  const KeyValues: String = ''): Variant; overload;
begin
  Result := GetFieldValue(FormatSQL(TableName, SelFields, KeyFields, KeyValues));
end;

{-----------------------------------------------------------------------------
  Procedure: GetFieldValue
  Purpose:   Get A Field Value
  Arguments: const SQLStatement: String
  Result:    Variant
  Author:    Cyclone
  Date:      2005-3-11 13:12:45

-----------------------------------------------------------------------------}
function GetFieldValue(const SQLStatement: String): Variant; overload;
begin
  Result := Unassigned;
  try
    with dsDynamicSQL do
    begin
      try
        if Active then
          Close;
        SQL.Clear;
        SQL.Add(SQLStatement);
        Open;
        if not IsEmpty then
          Result := Fields[0].Value;
      finally
        Close;
      end;
    end;
  except
    ShowError('SQL statement error');
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: GetMultiFieldValue
  Purpose:   GetMultiFieldValue
  Arguments: const TableName, SelFields: String;
             const KeyFields: String = '';
             const KeyValues: String = ''
  Result:    Variant
  Author:    Cyclone
  Date:      2005-3-11 13:12:35

-----------------------------------------------------------------------------}
function GetMultiFieldValue(const TableName, SelFields: String; const KeyFields: String = '';
  const KeyValues: String = ''): Variant; overload;
begin
  Result := GetMultiFieldValue(FormatSQL(TableName, SelFields, KeyFields, KeyValues));
end;

{-----------------------------------------------------------------------------
  Procedure: GetMultiFieldValue
  Purpose:   Get Multi Fields Value
  Arguments: const SQLStatement: String
  Result:    Variant
  Author:    Cyclone
  Date:      2005-3-11 13:12:24

-----------------------------------------------------------------------------}
function GetMultiFieldValue(const SQLStatement: String): Variant; overload;
var
  i: Integer;
begin
  Result := Unassigned;
  try
    with dsDynamicSQL do
    begin
      try
        if Active then
          Close;
        SQL.Clear;
        SQL.Add(SQLStatement);
        Open;
        if not IsEmpty then
        begin
          if FieldCount = 1 then
          begin
            //When TStringField.Value = null, Value assign to WinControl.Text will raise a Exception
            if Fields[0] is TStringField then
              Result := Fields[0].AsString
            else
              Result := Fields[0].Value;
          end
          else
          begin
            Result := VarArrayCreate([0, FieldCount - 1], varVariant);
            for i := 0 to FieldCount - 1 do
            begin
              //When TStringField.Value = null, Value assign to WinControl.Text will raise a Exception
              if Fields[i] is TStringField then
                Result[i] := Fields[i].AsString
              else
                Result[i] := Fields[i].Value;
            end;
          end;
        end;
      finally
        Close;
      end;
    end;
  except
    ShowError('SQL statement error');
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: IsExists
  Purpose:   IsExists
  Arguments: const TableName, SelFields: String;
             const KeyFields: String = '';
             const KeyValues: String = ''
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-11 13:11:22

-----------------------------------------------------------------------------}
function IsExists(const TableName, SelFields: String; const KeyFields: String = '';
  const KeyValues: String = ''): Boolean; overload;
begin
  Result := IsExists(FormatSQL(TableName, SelFields, KeyFields, KeyValues));
end;

{-----------------------------------------------------------------------------
  Procedure: IsExists
  Purpose:   Is Exists
  Arguments: const SQLStatement: String
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-11 13:11:09

-----------------------------------------------------------------------------}
function IsExists(const SQLStatement: String): Boolean; overload;
begin
  Result := False;
  with dsDynamicSQL do
  begin
    try
      if Active then
        Close;
      SQL.Clear;
      SQL.Add(SQLStatement);
      try
        Open;
        if not IsEmpty then
          Result := True;
      except
        ShowError('SQL statement error');
      end;
    finally
      Close;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: Encrypt
  Purpose:   Encrypt String
  Arguments: Src: String; Key: String
  Result:    String
  Author:    Cyclone
  Date:      2005-3-11 13:11:00

-----------------------------------------------------------------------------}
function Encrypt(Src: String; Key: String): String;
var
  KeyLen: Integer;
  KeyPos: Integer;
  offset: Integer;
  dest: String;
  SrcPos: Integer;
  SrcAsc: Integer;
  Range: Integer;
begin
  if Trim(Src) = '' then
  begin
    Result := '';
    Exit;
  end;
  KeyLen := Length(Key);
  if KeyLen = 0 then
    key := 'Think Space';
  KeyPos := 0;
  Range := 256;
  Randomize;
  offset := Random(Range);
  dest := format('%1.2x',[offset]);
  for SrcPos := 1 to Length(Src) do
  begin
    SrcAsc := (Ord(Src[SrcPos]) + offset) mod 255;
    if KeyPos < KeyLen then
      KeyPos :=  KeyPos + 1
    else
      KeyPos := 1;
    SrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    dest := dest + format('%1.2x',[SrcAsc]);
    offset := SrcAsc;
  end;
  Result := Dest;
end;

{-----------------------------------------------------------------------------
  Procedure: Decrypt
  Purpose:   Decrypt String
  Arguments: Src: String; Key: String
  Result:    String
  Author:    Cyclone
  Date:      2005-3-11 13:10:50

-----------------------------------------------------------------------------}
function Decrypt(Src: String; Key: String): String;
var
  KeyLen: Integer;
  KeyPos: Integer;
  offset: Integer;
  dest: String;
  SrcPos: Integer;
  SrcAsc: Integer;
  TmpSrcAsc: Integer;
begin
  if Trim(Src) = '' then
  begin
    Result := '';
    Exit;
  end;
  KeyLen := Length(Key);
  if KeyLen = 0 then
    key := 'Think Space';
  KeyPos := 0;
  offset := StrToInt('$' + Copy(src, 1, 2));
  SrcPos := 3;
  repeat
    SrcAsc := StrToInt('$'+ Copy(src, SrcPos, 2));
    if KeyPos < KeyLen then
      KeyPos := KeyPos + 1
    else
      KeyPos := 1;
    TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    if TmpSrcAsc <= offset then
      TmpSrcAsc := 255 + TmpSrcAsc - offset
    else
      TmpSrcAsc := TmpSrcAsc - offset;
    dest := dest + Chr(TmpSrcAsc);
    offset := srcAsc;
    SrcPos := SrcPos + 2;
  until SrcPos >= Length(Src);
  Result := Dest;
end;

{-----------------------------------------------------------------------------
  Procedure: OpenDataSet
  Purpose:   OpenDataSet
  Arguments: const TableName, SelFields: String;
             const KeyFields: String = '';
             const KeyValues: String = '';
             const OrderFields: String = ''
  Result:    TADOQuery
  Author:    Cyclone
  Date:      2005-3-11 13:10:34

-----------------------------------------------------------------------------}
function OpenDataSet(const TableName, SelFields: String; const KeyFields: String = '';
  const KeyValues: String = ''; const OrderFields: String = ''): TADOQuery;
begin
  Result := OpenDataSet(FormatSQL(TableName, SelFields, KeyFields, KeyValues, OrderFields));
end;

{-----------------------------------------------------------------------------
  Procedure: OpenDataSet
  Purpose:   Open DataSet
  Arguments: const SQLStatement: String
  Result:    TADOQuery
  Author:    Cyclone
  Date:      2005-3-11 13:09:36

-----------------------------------------------------------------------------}
function OpenDataSet(const SQLStatement: String): TADOQuery; overload;
begin
  Result := TADOQuery.Create(Application);
  with Result do
  begin
    Connection := dsDynamicSQL.Connection;
    SQL.Clear;
    SQL.Add(SQLStatement);
    try
      Open;
    except
      Free;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: ExecuteSQL
  Purpose:   Execute SQL Statement
  Arguments: const SQLStatement: String
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-11 13:09:23

-----------------------------------------------------------------------------}
function ExecuteSQL(const SQLStatement: String): Boolean; overload;
begin
  Result := True;
  with dsDynamicSQL do
  begin
    if Active then
      Close;
    SQL.Clear;
    SQL.Add(SQLStatement);
    try
      ExecSQL;
    except
      Result := False;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: IsDataSetInEdit
  Purpose:   Is DataSet In Edit
  Arguments: ADatasSet: TDataSet
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-11 13:09:01

-----------------------------------------------------------------------------}
function IsDataSetInEdit(ADatasSet: TDataSet): Boolean;
begin
  Result := ADatasSet.State in [dsInsert, dsEdit];
end;

{-----------------------------------------------------------------------------
  Procedure: GetFileIcon
  Purpose:   Get File Icon
  Arguments: const Filename:String; SmallIcon:Boolean
  Result:    HICON
  Author:    Cyclone
  Date:      2005-3-11 13:08:57

-----------------------------------------------------------------------------}
function GetFileIcon(const Filename:String; SmallIcon:Boolean):HICON;
var
  info: TSHFILEINFO;
  Flag: Integer;
begin
  if SmallIcon then
    Flag := (SHGFI_SMALLICON or SHGFI_ICON)
  else
    Flag := (SHGFI_LARGEICON or SHGFI_ICON);
  SHGetFileInfo(Pchar(Filename), 0, info, Sizeof(info), Flag);
  Result := info.hIcon;
end;

{-----------------------------------------------------------------------------
  Procedure: TfmMain.AlignCenter
  Purpose:   TfmMain.AlignCenter
  Arguments: OuterControl, InnerControl: TControl
  Result:    None
  Author:    Cyclone
  History:   2004-7-19 22:07:37

-----------------------------------------------------------------------------}
procedure AlignCenter(OuterControl, InnerControl: TControl);
begin
  InnerControl.Left := (OuterControl.Width - InnerControl.Width) div 2;
  InnerControl.Top := (OuterControl.Height - InnerControl.Height) div 2;
end;

{-----------------------------------------------------------------------------
  Procedure: ClearImage
  Purpose:   ClearImage
  Arguments: ParentControl: TPanel; AImage: TImage
  Result:    None
  Author:    Cyclone
  History:   2004-7-21 20:44:27

-----------------------------------------------------------------------------}
procedure ClearImage(ParentControl: TPanel; AImage: TImage32);
begin
  with AImage do
  begin
    Bitmap.SetSize(64, 64);
    Width := 64;
    Height := 64;
    Left := (ParentControl.Width - Width) div 2;
    Top := (ParentControl.Height - Height) div 2;
    Bitmap.Clear(Color32(ParentControl.Color));
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TfmMain.FitImage
  Purpose:   TfmMain.FitImage
  Arguments: ParentControl: TPanel; AImage: TImage; FitType: TFitType
  Result:    None
  Author:    Cyclone
  History:   2004-7-8 23:43:40

-----------------------------------------------------------------------------}
procedure FitImage(ParentControl: TPanel; AImage: TImage32; FitType: TFitType);
var
  HeightRate,
  WidthRate,
  HeightToWidthRate,
  WidthToHeightRate: Double;
begin
  with AImage do
  begin
    HeightRate := Bitmap.Height / ParentControl.Height;
    WidthRate := Bitmap.Width / ParentControl.Width;