pubfuns.pas

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

{ *********************************************************************** }
{ Unit Name: PubFuns
{ Purpose: declare public constant,type,variable,procedure and function.
{ Author: Cyclone
{ History:
{         2004-5-31 23:40:55 Create the function
{ *********************************************************************** }

unit PubFuns;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ADODB, DB, ComObj, StrUtils, ShellApi, ExtCtrls, ComCtrls,
  Math, Registry, GR32_Image, GR32, IniFiles;

{ public constant declarations }
const
  WM_ICONMESSAGE = WM_USER + 100;
  FolderIndex = 0;
  DocumentIndex = 1;
  CATEGORY = 'CATEGORY';
  DOCUMENT = 'DOCUMENT';
  MaxHistoryTreeNodeCount = 10;
  C1 = 52845;
  C2 = 22719;
  PassContext = 'Cyclone';
  PasswordKey = 25535;
  CRLF = #13#10;
  EncryptBits = 100;
  ImageMarginWidth = 5;

{ public type declarations}
type
  TNetResourceArray = ^TNetResource; //网络类型的数组
  
  TFitType = (ftAutoFit, ftFitWidth, ftFitHeight);

  TItemType = (itCategory, itDocument);

  TImportFileExistsAction = (iaAddPrefix, iaLink, iaOverwrite, iaSkip);

  TExportFileExistsAction = (eaAddPrefix, eaOverwrite, eaSkip);

  TDatabaseType = (dtAccess, dtSQLServer);

  TInformationType = (intInformation, intWarning, intError, intQuestion);

  TSortType = (stAsc, stDesc);

  PTreeNodeObj = ^TTreeNodeObj;
  TTreeNodeObj = Record
    CategoryCode: String;
    CategoryName: String;
    ParentCategoryCode: String;
    Remarks: String;
    Creator: String;
    CreateDate: TDateTime;
    LastModifier: String;
    LastModifyDate: TDateTime;
    ModifyTimes: Integer;
  end;

  PListItemObj = ^TListItemObj;
  TListItemObj = Record
    ItemType: TItemType;
    DocNo: String;
    DocType: String;
    DocName: String;
    FileName: String;
    FileSize: Double;
    OriginalExtName: String;
    Version: String;
    Remarks: String;
    Creator: String;
    CreateDate: TDateTime;
    LastModifier: String;
    LastModifyDate: TDateTime;
    ModifyTimes: Integer;
  end;

{ public variable declarations}
var
  pSystemName: String;
  pSystemVersion: String;
  pCompanyWebSite: String;
  pCompanyEmail: String;
  pSysUserId,
  pSysUserPassword: String;

  pRootPath: String;

  pPrefix,
  pYearString,
  pMonthString,
  pDayString: String;
  pNoPlace: Integer;

  pIniFileName: String;
  pDatabaseType: TDatabaseType;

  pAccessFileName,
  pDBServerName,
  pDBName,
  pDBUserName,
  pDBPassword: String;

  pUseSkin: Boolean;
  pMainFormTop,
  pMainFormLeft,
  pMainFormHeight,
  pMainFormWidth: Integer;
  pMainFormState: TWindowState;
  pImagePreviewTop,
  pImagePreviewLeft,
  pImagePreviewHeight,
  pImagePreviewWidth: Integer;
  pImagePreviewState: TWindowState;
  pImagePreviewShowInformation: Boolean;

  dsDynamicSQL: TADOQuery;

{ public procedure and function declarations}

  //Information routines
  procedure ShowInformation(const Msg: String);
  procedure ShowError(const Msg: String);
  procedure ShowWarning(const Msg: String);
  function ShowYesNo(const Msg: String): Boolean;

  //Date routines
  function FirstDayOfMonth(const Year, Month: Word): TDate;
  function LastDayOfMonth(const Year, Month: Word): TDate;
  function GetSQLServerDatetime: TDateTime;
  function GetAccessDatetime: TDateTime;
  function GetServerDatetime(const DatabaseType: TDatabaseType): TDateTime;

  //Network routines
  function GetDomainList(var List: TStringList): Boolean;
  function GetComputerList(const GroupName: string; var List: TStringList): Boolean;
  function GetLocalComputerName: String;
  function ConnectTo(const ComputerName, UserName, Password: String): Boolean;

  //File system routines
  function FileToVariant(const FileName: String): OleVariant;
  procedure VariantToFile(const FileName: String; var AVariant: OleVariant);
  function EncryptFile(const InFileName, OutFileName: String; Key: Word): Boolean;
  function DecryptFile(const InFileName, OutFileName: String; Key: Word): Boolean;
  function GetSystemTempPath: String;
  function GetSystemTempFileName(const PathName, PrefixString: String;
    const UniqueCode: Cardinal): String;
  function GetFileIcon(const Filename:String; SmallIcon:Boolean):HICON;
  function IsDirectory(SearchRec: TSearchRec): Boolean;
  procedure SearchFiles(const Directory, Wildcard: String; var FileList: TStringList;
    const IncludeSubDirectory: Boolean = False);
  procedure DeleteHistoryFiles(FileList: TStringList);
  function GetFileExtension(FileName: String): String;
  function ConvertToCYCFile(const srcFileName, DestFileName: String): Boolean;
  function GetFileSize(const AFileName: String): Integer;
  function IsTextFile(const AFileName: String): Boolean;

  //Registry routines
  procedure AutoStartWhenOsStart(const KeyName: String; const IsAutoStart: Boolean);

  //INI File routines
  procedure ReadConnectionInformation;

  //String routines
  procedure AddSeparater(const Separater: String; var SourceStr: String);
  function GetAddSeparaterStr(const Separater, SourceStr: String): String;
  function StrContainCount(const SourceStr, FindStr: String): Integer;
  function PadLeft(const SouceStr, PadStr: String; const Length: Integer): String;
  function PadRight(const SouceStr, PadStr: String; const Length: Integer): String;

  function Encrypt(Src: String; Key: String): String;
  function Decrypt(Src: String; Key: String): String;


  //Database routines
  function GetSQLServerConnectionString(const ServerName, DBName, UserName, Password: String): String;
  function GetSQLServerList(var AList: TStrings): Boolean;
  function GetAccessConnectionString(const FileName: String): String;

  function FormatSQL(const TableName, SelFields: String; const KeyFields: String = '';
    const KeyValues: String = ''; const OrderFields: String = ''): String;

  function OpenDataSet(const TableName, SelFields: String; const KeyFields: String = '';
    const KeyValues: String = ''; const OrderFields: String = ''): TADOQuery; overload;
  function OpenDataSet(const SQLStatement: String): TADOQuery; overload;

  function IsDataSetInEdit(ADatasSet: TDataSet): Boolean;

  function ExecuteSQL(const SQLStatement: String): Boolean; overload;

  function GetFieldValue(const TableName, SelFields: String; const KeyFields: String = '';
    const KeyValues: String = ''): Variant; overload;
  function GetFieldValue(const SQLStatement: String): Variant; overload;

  function GetMultiFieldValue(const TableName, SelFields: String; const KeyFields: String = '';
    const KeyValues: String = ''): Variant; overload;
  function GetMultiFieldValue(const SQLStatement: String): Variant; overload;

  function IsExists(const TableName, SelFields: String; const KeyFields: String = '';
    const KeyValues: String = ''): Boolean; overload;
  function IsExists(const SQLStatement: String): Boolean; overload;

  //Graphic routines
  procedure AlignCenter(OuterControl, InnerControl: TControl);
  procedure ClearImage(ParentControl: TPanel; AImage: TImage32);
  procedure FitImage(ParentControl: TPanel; AImage: TImage32; FitType: TFitType = ftAutoFit);
  function DrawFile(ParentControl: TPanel; AImage: TImage32; FolderImage, WarningImage: TImage;
    pListItemObj: PListItemObj): Boolean;
  procedure DrawItem(ListView: TCustomListView; const ARect: TRect; pListItemObj: PListItemObj);
  function IsImage(const AListItem: TListItem): Boolean;


implementation

uses InformationF;

{-----------------------------------------------------------------------------
  Procedure: ShowInformation
  Purpose:   Show Information
  Arguments: const Msg: String
  Result:    None
  Author:    Cyclone
  Date:      2005-3-11 13:22:02

-----------------------------------------------------------------------------}
procedure ShowInformation(const Msg: String);
begin
  //MessageBox(Application.Handle, Pchar(Msg), 'Information', MB_OK + MB_ICONINFORMATION);
  TfmInformation.ShowInformation(intInformation, Msg);
end;

{-----------------------------------------------------------------------------
  Procedure: ShowError
  Purpose:   Show Error
  Arguments: const Msg: String
  Result:    None
  Author:    Cyclone
  Date:      2005-3-11 13:21:57

-----------------------------------------------------------------------------}
procedure ShowError(const Msg: String);
begin
  //MessageBox(Application.Handle, Pchar(Msg), 'Error', MB_OK + MB_ICONERROR);
  TfmInformation.ShowInformation(intError, Msg);
end;

{-----------------------------------------------------------------------------
  Procedure: ShowWarning
  Purpose:   Show Warning
  Arguments: const Msg: String
  Result:    None
  Author:    Cyclone
  Date:      2005-3-11 13:21:49

-----------------------------------------------------------------------------}
procedure ShowWarning(const Msg: String);
begin
  //MessageBox(Application.Handle, Pchar(Msg), 'Warning', MB_OK + MB_ICONWARNING);
  TfmInformation.ShowInformation(intWarning, Msg);
end;

{-----------------------------------------------------------------------------
  Procedure: ShowYesNo
  Purpose:   Show Yes No
  Arguments: const Msg: String
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-11 13:21:41

-----------------------------------------------------------------------------}
function ShowYesNo(const Msg: String): Boolean;
begin
  //Result := MessageBox(Application.Handle, Pchar(Msg), 'Question', MB_YESNO + MB_ICONQUESTION) = ID_YES;
  Result := TfmInformation.ShowInformation(intQuestion, Msg) = mrYes;
end;

{-----------------------------------------------------------------------------
  Procedure: FirstDayOfMonth
  Purpose:   Get First Day Of A Month
  Arguments: const Year, Month: Word
  Result:    TDate
  Author:    Cyclone
  Date:      2005-3-11 13:21:20

-----------------------------------------------------------------------------}
function FirstDayOfMonth(const Year, Month: Word): TDate;
begin
  Result := EncodeDate(Year, Month, 1);
end;

{-----------------------------------------------------------------------------
  Procedure: LastDayOfMonth
  Purpose:   Get Last Day Of A Month
  Arguments: const Year, Month: Word
  Result:    TDate
  Author:    Cyclone
  Date:      2005-3-11 13:21:05

-----------------------------------------------------------------------------}
function LastDayOfMonth(const Year, Month: Word): TDate;
var
  iYear,
  iMonth: Word;
begin
  if Month = 12 then
  begin
    iMonth := 1;
    iYear  := Year + 1;
  end else
  begin
    iMonth := Month + 1;
    iYear  := Year;
  end;
  Result := EncodeDate(iYear, iMonth, 1) - 1;
end;

{-----------------------------------------------------------------------------
  Procedure: GetSQLServerDatetime
  Purpose:   Get SQL Server Date Time
  Arguments: None
  Result:    TDateTime
  Author:    Cyclone
  Date:      2005-3-11 13:19:51

-----------------------------------------------------------------------------}
function GetSQLServerDatetime: TDateTime;
begin
  with dsDynamicSQL do
  begin
    try
      if Active then Close;
      SQL.Clear;
      SQL.Add('SELECT fldSystemDate = GetDate()');
      Open;
      Result := Fields[0].AsDateTime;
    finally
      Close;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: GetAccessDatetime
  Purpose:   Get Access Datetime
  Arguments: None
  Result:    TDateTime
  Author:    Cyclone
  Date:      2005-3-18 23:28:21

-----------------------------------------------------------------------------}
function GetAccessDatetime: TDateTime;
begin
  with dsDynamicSQL do
  begin
    try
      if Active then Close;
      SQL.Clear;
      SQL.Add('SELECT NOW()');
      Open;
      Result := Fields[0].AsDateTime;
    finally
      Close;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: GetServerDatetime
  Purpose:   GetServerDatetime
  Arguments: const DatabaseType: TDatabaseType
  Result:    TDateTime
  Author:    Cyclone
  Date:      2005-3-19 14:11:24

-----------------------------------------------------------------------------}
function GetServerDatetime(const DatabaseType: TDatabaseType): TDateTime;
begin
  if DatabaseType = dtAccess then
    Result := GetAccessDatetime
  else
    Result := GetSQLServerDatetime;
end;

{-----------------------------------------------------------------------------
  Procedure: GetDomainList
  Purpose:   Get Domain List In Local Network
  Arguments: var List: TStringList
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-11 13:19:32

-----------------------------------------------------------------------------}
function GetDomainList(var List: TStringList): Boolean;
var
  NetResource : TNetResource;
  Buf: Pointer;
  Count, BufSize, Res: DWORD;
  lphEnum: THandle;
  p: TNetResourceArray;
  i,j: SmallInt;
  NetworkTypeList: TList;
begin
  Result := False;
  NetworkTypeList := TList.Create;
  try
    List.Clear;
    Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
    if Res <> NO_ERROR then
      Exit;
    Count := $FFFFFFFF;        //不限资源数目
    BufSize := 8192;           //缓冲区大小设置为8K
    GetMem(Buf, BufSize);      //申请内存，用于获取工作组信息
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
    if (Res = ERROR_NO_MORE_ITEMS) or (Res <> NO_ERROR ) then
      Exit;
    P := TNetResourceArray(Buf);
    for I := 0 to Count - 1 do
    begin
      NetworkTypeList.Add(P);
      Inc(P);
    end;

    Res := WNetCloseEnum(lphEnum);
    if Res <> NO_ERROR then
      Exit;

    for J := 0 to NetworkTypeList.Count - 1 do
    begin
      NetResource := TNetResource(NetworkTypeList.Items[J]^);
      Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
      if Res <> NO_ERROR then
        Break;
      while True do
      begin
        Count := $FFFFFFFF;        //不限资源数目
        BufSize := 8192;           //缓冲区大小设置为8K
        GetMem(Buf, BufSize);      //申请内存，用于获取工作组信息
        Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
        if (Res = ERROR_NO_MORE_ITEMS) or (Res <> NO_ERROR) then
          Break;
        P := TNetResourceArray(Buf);
        for I := 0 To Count - 1 do
        begin
          List.Add(StrPAS(P^.lpRemoteName));
          Inc(P);
        end;
      end;
      Res := WNetCloseEnum(lphEnum);
      if Res <> NO_ERROR then
        Break;
    end;
    Result := True;
    FreeMem(Buf);
  finally
    NetworkTypeList.Free;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: GetComputerList
  Purpose:   Get Computer List In Local Network
  Arguments: const GroupName: string;
             var List: TStringList
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-11 13:19:11

-----------------------------------------------------------------------------}
function GetComputerList(const GroupName: string; var List: TStringList): Boolean;