pubfuns.pas

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

Var
  NetResource : TNetResource;
  Buf: Pointer;
  Count, BufSize, Res: DWord;
  Ind: Integer;
  lphEnum: THandle;
  Temp: TNetResourceArray;
begin
  Result := False;
  List.Clear;
  FillChar(NetResource, SizeOf(NetResource), 0);
  NetResource.lpRemoteName := @GroupName[1];
  NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;
  NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
  NetResource.dwScope := RESOURCETYPE_DISK;
  Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource, lphEnum);
  if Res <> NO_ERROR then
    Exit;
  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 then
      Break;
    if (Res <> NO_ERROR) then
      Exit;
    Temp := TNetResourceArray(Buf);
    for Ind := 0 to Count - 1 do
    begin
      List.Add(Temp^.lpRemoteName + 2); //获取工作组的计算机名称，+2表示删除"\\"，如\\Cyclone=>Cyclone
      Inc(Temp);
    end;
    FreeMem(Buf);
  end;
  Res := WNetCloseEnum(lphEnum);
  if Res <> NO_ERROR then
    exit;
  Result := True;
end;

{-----------------------------------------------------------------------------
  Procedure: GetLocalComputerName
  Purpose:   Get Local Computer Name
  Arguments: None
  Result:    String
  Author:    Cyclone
  Date:      2005-3-11 13:19:01

-----------------------------------------------------------------------------}
function GetLocalComputerName: String;
var
  ComputerName: PChar;
  BufSize: Cardinal;
begin
  Result := '';
  BufSize := MAX_COMPUTERNAME_LENGTH;
  GetMem(ComputerName, BufSize);
  try
    GetComputerName(ComputerName, BufSize);
    Result := ComputerName;
  finally
    FreeMem(ComputerName);
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: ConnectTo
  Purpose:   Connect To A Computer In Local Network
  Arguments: const ComputerName, UserName, Password: String
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-11 13:18:31

-----------------------------------------------------------------------------}
function ConnectTo(const ComputerName, UserName, Password: String): Boolean;
var
  NetRes: _NETRESOURCEA;
  ServerName: String;
begin
  Result := False;
  ServerName := Trim(ComputerName);
  if ServerName = '' then
    Exit;
  if LeftStr(ServerName, 2) <> '\\' then
    ServerName := '\\' + ServerName;
  with NetRes do
  begin
    dwsCope := RESOURCE_GLOBALNET;
    dwType := RESOURCETYPE_ANY;
    dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;
    dwUsage := RESOURCEUSAGE_CONNECTABLE;
    lpLocalName := '';
    lpRemoteName := Pchar(ServerName);
    lpComment := '';
    lpProvider := '';
  end;
  Result := WNetAddConnection2(NetRes, Pchar(Password), Pchar(UserName), CONNECT_UPDATE_PROFILE) = NO_ERROR;
end;

{-----------------------------------------------------------------------------
  Procedure: FileToVariant
  Purpose:   File To Variant
  Arguments: const FileName: String
  Result:    OleVariant
  Author:    Cyclone
  Date:      2005-3-11 13:18:22

-----------------------------------------------------------------------------}
function FileToVariant(const FileName: String): OleVariant;
var
  AStream: TFileStream;
  MyBuffer: Pointer;
begin
  AStream := TFileStream.create(FileName, fmOpenRead);
  try
    aStream.Seek(0, soFromBeginning);
    Result := VarArraycreate([0, AStream.size - 1], VarByte);
    MyBuffer := VarArrayLock(Result);
    AStream.ReadBuffer(MyBuffer^, AStream.Size);
    VarArrayUnlock(Result);
  finally
    AStream.Free;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: VariantToFile
  Purpose:   Variant To File
  Arguments: const FileName: String;
             var AVariant: OleVariant
  Result:    None
  Author:    Cyclone
  Date:      2005-3-11 13:18:12

-----------------------------------------------------------------------------}
procedure VariantToFile(const FileName: String; var AVariant: OleVariant);
var
  AStream: TFileStream;
  MyBuffer: Pointer;
  Size: Integer;
begin
  AStream := TFileStream.create(FileName, fmCreate);
  try
    aStream.Seek(0, soFromBeginning);
    Size := VarArrayHighBound(AVariant, 1) + VarArrayLowBound(AVariant, 1) + 1;
    MyBuffer := VarArrayLock(AVariant);
    AStream.WriteBuffer(MyBuffer^, Size);
    VarArrayUnlock(AVariant);
  finally
    AStream.Free;
  end;
end;

{-----------------------------------------------------------------------------
  function: EncryptFile
  Purpose:   Encrypt File
  Arguments: const InFileName, OutFileName: String;
             Key: Word
  Result:    None
  Author:    Cyclone
  History:   2004-6-29 23:03:17

-----------------------------------------------------------------------------}
function EncryptFile(const InFileName, OutFileName: String; Key: Word): Boolean;
var
  MS, SS : TMemoryStream;
  X : Integer;
  C : Byte;
  EncryptSize: Integer;
  OriginalCursor: TCursor;
begin
  Result := False;
  MS := TMemoryStream.Create;
  SS := TMemoryStream.Create;
  OriginalCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  try
    MS.LoadFromFile(InFileName);
    MS.Position := 0;
    EncryptSize := Min(MS.Size, EncryptBits);
    for X := 0 to EncryptSize - 1 do
    begin
      MS.Read(C, 1);
      C := (C xor (Key shr 8));
      Key := (C + Key) * C1 + C2;
      SS.Write(C,1);
    end;
    if MS.Size > EncryptBits then
      SS.CopyFrom(MS, MS.Size - EncryptBits);
    SS.SaveToFile(OutFileName);
    Result := FileExists(OutFileName);
  finally
    SS.Free;
    MS.Free;
    Screen.Cursor := OriginalCursor;
  end;
end;

{-----------------------------------------------------------------------------
  Function: DecryptFile
  Purpose:   Decrypt File
  Arguments: const InFileName, OutFileName: String;
             Key: Word
  Result:    Boolean
  Author:    Cyclone
  History:   2004-6-29 23:03:22

-----------------------------------------------------------------------------}
function DecryptFile(const InFileName, OutFileName: String; Key: Word): Boolean;
var
  MS, SS : TMemoryStream;
  X : Integer;
  C, O : Byte;
  EncryptSize: Integer;
  OriginalCursor: TCursor;
begin
  Result := False;
  MS := TMemoryStream.Create;
  SS := TMemoryStream.Create;
  OriginalCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  try
    MS.LoadFromFile(InFileName);
    MS.Position := 0;
    EncryptSize := Min(MS.Size, EncryptBits);
    for X := 0 to EncryptSize - 1 do
    begin
      MS.Read(C, 1);
      O := C;
      C := (C xor (Key shr 8));
      Key := (O + Key) * C1 + C2;
      SS.Write(C,1);
    end;
    if MS.Size > EncryptBits then
      SS.CopyFrom(MS, MS.Size - EncryptBits);
    SS.SaveToFile(OutFileName);
    Result := FileExists(OutFileName);
  finally
    SS.Free;
    MS.Free;
    Screen.Cursor := OriginalCursor;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: GetFileSize
  Purpose:   Get File Size
  Arguments: const AFileName: String
  Result:    Integer
  Author:    Cyclone
  History:   2004-12-18 22:59:25

-----------------------------------------------------------------------------}
function GetFileSize(const AFileName: String): Integer;
var
  HFile: file;
begin
  Result := 0;
  if FileExists(AFileName) then
  begin
    AssignFile(HFile, AFileName);
    Reset(HFile, 1);
    try
      Result := FileSize(HFile);
    finally
      CloseFile(HFile);
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: IsTextFile
  Purpose:   Is Text File
  Arguments: const AFileName: String
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-30 22:16:55

-----------------------------------------------------------------------------}
function IsTextFile(const AFileName: String): Boolean;
var
  FileStream : TFileStream;
  ABype: byte;
  i,
  ZeroCount: integer;
begin
  Result := False;
  if FileExists(AFileName) then
    Exit;
  FileStream := TFileStream.Create(AFileName, fmOpenread);
  try
    ZeroCount := 0;
    for i := 1 to 512 do
    begin
      FileStream.Position := Random(FileStream.Size - 1);
      FileStream.Read(ABype, SizeOf(ABype));
      if ABype = 0 then Inc(ZeroCount);
    end;
  finally
    FileStream.Free;
  end;
  Result := ZeroCount < 8;
end;

{-----------------------------------------------------------------------------
  Procedure: GetSystemTempPath
  Purpose:   Get System Temp Path
  Arguments: None
  Result:    String
  Author:    Cyclone
  Date:      2005-3-11 13:17:33

-----------------------------------------------------------------------------}
function GetSystemTempPath: String;
var
  Path: PChar;
begin
  Result := '';
  GetMem(Path, 255);
  try
    GetTempPath(255, Path);
    Result := StrPas(Path);
  finally
    FreeMem(Path);
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: GetSystemTempFileName
  Purpose:   Get System Temp File Name
  Arguments: const PathName, PrefixString: String;
             const UniqueCode: Cardinal
  Result:    String
  Author:    Cyclone
  Date:      2005-3-11 13:15:59

-----------------------------------------------------------------------------}
function GetSystemTempFileName(const PathName, PrefixString: String; const UniqueCode: Cardinal): String;
var
  FileName: PChar;
begin
  Result := '';
  GetMem(FileName, 255);
  try
    GetTempFileName(PChar(PathName), PChar(PrefixString), UniqueCode, FileName);
    Result := StrPas(FileName);
  finally
    FreeMem(FileName);
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: AddSeparater
  Purpose:   Add Separater
  Arguments: const Separater: String;
             var SourceStr: String
  Result:    None
  Author:    Cyclone
  Date:      2005-3-11 13:15:50

-----------------------------------------------------------------------------}
procedure AddSeparater(const Separater: String; var SourceStr: String);
var
  SeparaterLength: Integer;
begin
  if SourceStr = '' then
    Exit;
  SeparaterLength := Length(Separater);
  if Copy(SourceStr, Length(SourceStr) - SeparaterLength + 1, SeparaterLength) <> Separater then
    SourceStr := SourceStr + Separater;
end;

{-----------------------------------------------------------------------------
  Procedure: GetAddSeparaterStr
  Purpose:   Get Add Separater Str
  Arguments: const Separater, SourceStr: String
  Result:    String
  Author:    Cyclone
  Date:      2005-3-11 13:15:35

-----------------------------------------------------------------------------}
function GetAddSeparaterStr(const Separater, SourceStr: String): String; overload;
var
  SeparaterLength: Integer;
begin
  if SourceStr = '' then
    Exit;
  SeparaterLength := Length(Separater);
  if Copy(SourceStr, Length(SourceStr) - SeparaterLength + 1, SeparaterLength) <> Separater then
    Result := SourceStr + Separater;
end;

{-----------------------------------------------------------------------------
  Procedure: StrContainCount
  Purpose:   A String Contain Another String Count
  Arguments: const SourceStr, FindStr: String
  Result:    Integer
  Author:    Cyclone
  Date:      2005-3-11 13:14:41

-----------------------------------------------------------------------------}
function StrContainCount(const SourceStr, FindStr: String): Integer;
var
  sSourceStr: String;
  iCount: Integer;
begin
  sSourceStr := SourceStr;
  iCount := 0;
  while Pos(FindStr, sSourceStr) > 0 do
  begin
    Inc(iCount);
    System.Delete(sSourceStr, 1, Pos(FindStr, sSourceStr));
  end;
  Result := iCount;
end;

{-----------------------------------------------------------------------------
  Procedure: GetSQLServerConnectionString
  Purpose:   Get SQL Server Connection String
  Arguments: const ServerName, Name, UserName, DBPassword: String
  Result:    String
  Author:    Cyclone
  History:   2005-1-11 21:26:59

-----------------------------------------------------------------------------}
function GetSQLServerConnectionString(const ServerName, DBName, UserName, Password: String): String;
begin
  Result := 'Provider=SQLOLEDB.1;Persist Security Info=True;' +
            'User ID=' + UserName + ';' +
            'Password=' + Password + ';' +
            'Initial Catalog=' + DBName + ';' +
            'Data Source=' + ServerName;
end;

function GetAccessConnectionString(const FileName: String): String;
begin
  Result := 'Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;' +
            'Data Source=' + FileName;
end;

{-----------------------------------------------------------------------------
  Procedure: GetSQLServerList
  Purpose:   Get SQL Server List In Local Network
  Arguments: var AList: TStrings
  Result:    Boolean
  Author:    Cyclone
  Date:      2005-3-11 13:13:34

-----------------------------------------------------------------------------}
function GetSQLServerList(var AList: TStrings): Boolean;
var
  SQLServerApp: Variant;
  ServerList: Variant;
  i: Integer;
begin
  Result := True;
  try
    SQLServerApp := CreateOleObject('SQLDMO.Application');
    ServerList := SQLServerApp.ListAvailableSQLServers;
    for i := 1 to ServerList.Count do
      AList.Add(ServerList.Item(i));
    SQLServerApp := Unassigned;
    ServerList := Unassigned;
  except
    Result := False;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: FormatSQL
  Purpose:   Format SQL Statement
  Arguments: const TableName, SelFields: String;