myutils.pas

简单封装数据库表的类的一个简单的例子： http://www.delphifans.com/SoftView/SoftView_1476.html

unit MyUtils;

interface

uses
   Windows, SysUtils, Registry, Classes, Forms, MMSystem,
   IdStack, IdWinSock2,  NB30, UnitAppLogger,
   syncobjs, Clipbrd, //HCMngr,
   Variants, Controls;

type
  TOnAppLog = procedure(Sender: TObject; Text: string) of object;


function ShowBox(Text: string; BoxType: Integer;
  CheckForLog: Boolean = false): Integer; overload;
function ShowBox(Text: string; CheckForLog: Boolean = false): Integer; overload;

function ShowBox(FormatText: string; Avgs: array of const; BoxType: Integer;
   CheckForLog: Boolean = false):  Integer; overload;

function ReadRegistryValue(Root: HKEY; Path: string;
  Name: string; VarType: TVarType): Variant;
function WriteRegistryValue(Root: HKEY; Path: string; Name: string;
  Value: Variant): Boolean;
procedure DeleteRegistryValue(Root: HKEY; Path: string; Name: string);

function ToString(Value: Variant): string;

procedure LogTextToFile(Sender: TObject; AFileName, AText: string;
  ShowDate: Boolean = True);
procedure DefaultAppLog(Sender: TObject; AText: string);

procedure ShowErrorBox(Text: string; CheckForLog: Boolean = false); overload;
procedure ShowErrorBox(FormatText: string; Avgs: array of const;
  CheckForLog: Boolean = false); overload;
function GetLocalIP: WideString;
function GetMACAddress: WideString;
function GetMachineName: WideString;
function CompressString(Source: WideString; AddLog: Boolean): WideString;
function DeCompressString(Source: WideString; AddLog: Boolean): WideString;
function Base64Encode(Source: TStream): WideString;
function Base64Decode(Source: WideString): TMemoryStream; overload;
//function Base64Decode(Source: WideString): WideString; overload;
function GetAppVersion: string;
function GetAppProductName: string;
function GetAppFileVersion: string;
function GetFileVersionInfo(AFileName: string): string;
function GetLock: TCriticalSection;
procedure ExecuteApp(FileName: string; RunPath: string = ''; ShowCmd: Integer = SW_SHOWNORMAL);
procedure ShowDefaultApplogFile;
function GetDefaultAppLogFileName: string;

function GetNewGUID: string;

function StringToList(AText: string; Splitter: string): TStrings;
function ListToString(AList: TStrings; Splitter: string): string;

procedure UpdateControlEnabled(AParent: TComponent; AEnabled: Boolean);
procedure UpdateWinControlEnabled(AParent: TWinControl; AEnabled: Boolean);
function StrBool(Str: string): Boolean;
function getFileDate(AFilename: string): TDateTime;

procedure SaveTextToClipboard(AText: WideString);

function GetAppTempFileName: string;
//function EncodeString(ASource: string; AKey: string; Encode: Boolean): string;

function CompareVersion(AStrNew, AStrOld: string): Boolean;

procedure CheckSQLServerProtocolOrder;

procedure ReadREG_MULTI_SZ(const CurrentKey: HKey; const Subkey, ValueName: string;
  Strings: TStrings);

function WriteREG_MULTI_SZ(const regRootKey: HKey; const Subkey, ValueName: string;
  Strings: PChar): Boolean;

function CheckAppMutex(AppID, MainFormClassName: string; MsgID: Integer): Boolean;

function GetRegRootKey(var APath: string): HKEY;

function GetWinDir: string;
function GetWinSystemDir: string;

var
  GlobalOnAppLog: TOnAppLog;
  fMuteHandle: Integer;

implementation

uses
   ZLib, IdBaseComponent, IdCoder, IdCoder3to4, IdCoderMIME, DateUtils,
   RxVerInf, ShellAPI, ComObj;


function StrBool(Str: string): Boolean;
begin
  result := (Str = '1') or SameText(Str,'True') or SameText(Str, 'Yes') or
    SameText(Str, 'Y');
end;


//function GetAppTempFileName(Prefix: string): string;
//var
////  fPath: PChar;
////  Buffer: PChar;
//  Buffer: array[0..MAX_PATH] of Char;
//begin
//  GetTempPath(MAX_PATH, Buffer);
////  GetTempFileName(fPath, PChar(Prefix), 0, Buffer);
//  result := Buffer + CreateClassID + '.tmp';
//  //string(Buffer);
//end;

function GetWinSystemDir: string;
var
  fTempPath: array[0..MAX_PATH] of char;
  fVer: OSVERSIONINFO;
begin
//  SetLength(fTempPath, MAX_PATH);
  GetSystemDirectory(fTempPath, MAX_PATH);
  result := Copy(fTemppath, 1, Length(fTempPath));
//  GetVersionEx(fVer);
//  if fVer.dwMajorVersion > 4 then
//    result := result + '32';
end;

function GetWinDir: string;
var
  fTempPath: array[0..MAX_PATH] of char;
  fValue: string;
begin
//  SetLength(fTempPath, MAX_PATH);      
//  fTempPath := EmptyStr;
  GetWindowsDirectory(fTempPath, MAX_PATH);
  result := Copy(fTemppath, 1, Length(fTempPath));
end;

function GetRegRootKey(var APath: string): HKEY;
var
  fStr: string;
begin
  fStr := Copy(APath, 1, AnsiPos('\', APath) - 1);
  if SameText(fStr, 'HKEY_LOCAL_MACHINE') then
    result := HKEY_LOCAL_MACHINE
  else
  if SameText(fStr, 'HKEY_CLASSES_ROOT') then
    result := HKEY_CLASSES_ROOT
  else
  if SameText(fStr, 'HKEY_USERS') then
    result := HKEY_USERS
  else
  if SameText(fStr, 'HKEY_CURRENT_CONFIG') then
    result := HKEY_CURRENT_CONFIG
  else
    result := HKEY_CURRENT_USER;
  APath := Copy(APath, Length(fStr) + 2, Length(APath));
end;

function GetFileVersionInfo(AFileName: string): string;
begin
  result := EmptyStr;
  if not FileExists(AFileName) then Exit;
    
  with TVersionInfo.Create(AFileName) do
  begin
    result := FileVersion;
    Free;
  end;    // with
end;

function GetAppTempFileName: string;
var
  fTempPath: string;
begin
  SetLength(fTempPath, MAX_PATH);
  GetTempPath(MAX_PATH, PChar(fTempPath));
  SetLength(Result, MAX_PATH + 1);
  GetTempFileName(PChar(fTempPath), '~TMP', 0, PChar(Result));
//  result := fName;
end;


function CheckAppMutex(AppID, MainFormClassName: string; MsgID: Integer): Boolean;
var
  fFormhandle: Integer;
begin
  fMuteHandle := CreateMutex(nil, True, PChar(AppID));
  result := not (GetLastError = ERROR_ALREADY_EXISTS);
  if not result then
  begin
    fFormhandle := FindWindow(PChar(MainFormClassName), nil);
    result := fFormhandle = 0;
    if not result then
    begin
//      ShowWindow(fFormhandle, SW_SHOWNORMAL);
      PostMessage(fFormhandle, MsgID, 0, 0);
    end;
//    result := False;
  end;
end;

function WriteREG_MULTI_SZ(const regRootKey: HKey; const Subkey, ValueName: string;
  Strings: PChar): Boolean;
begin
  with TRegistry.Create do
  begin
    try
      RootKey := regRootKey;
      result := OpenKey(Subkey, True);
      if result then
      begin
        result :=
        RegSetValueEx(
            CurrentKey,     // handle of key to set value for
            PChar(ValueName),        // address of value to set
            0,                  // reserved
            REG_MULTI_SZ,       // flag for value type
            PChar(Strings + #0#0),         // address of value data
            Length(Strings) + 2) = ERROR_SUCCESS;
      end;
    finally
      CloseKey;
      Free;
    end;
  end;    // with
end;

procedure CheckSQLServerProtocolOrder;
const
  sqlClientRegPath = 'SOFTWARE\Microsoft\MSSQLServer\Client\SuperSocketNetLib';
  sqlProtocolOrder = 'ProtocolOrder';
var
  I: Integer;
  fList: TStrings;
  fKey: HKEY;
  fValue: PChar;
begin
  fList := TStringList.Create;
  try
    ReadREG_MULTI_SZ(HKEY_LOCAL_MACHINE, sqlClientRegPath,
      sqlProtocolOrder, fList);
    if (fList.Text = EmptyStr) or (Copy(fList.Text, 1, 3) <> 'tcp') then
    begin
      if (fList.IndexOf('tcp') <> -1) then
        fList.Delete(fList.IndexOf('tcp'));
      fList.Insert(0, 'tcp');
      fValue := PChar(StringReplace(fList.Text, sLineBreak, #0#0, [rfReplaceAll]));
      WriteREG_MULTI_SZ(HKEY_LOCAL_MACHINE, sqlClientRegPath,
        sqlProtocolOrder, fValue);
    end;
  finally
    fList.Free;
  end;
end;

procedure ReadREG_MULTI_SZ(const CurrentKey: HKey; const Subkey, ValueName: string;
  Strings: TStrings);
var
  valueType: DWORD;
  valueLen: DWORD;
  p, buffer: PChar;
  key: HKEY;
begin
  // Clear TStrings
  // TStrings leeren
  Strings.Clear;
  // open the specified key
  // CurrentKey Schlüssel ?ffnen
  if RegOpenKeyEx(CurrentKey,
                  PChar(Subkey),
                  0, KEY_READ, key) = ERROR_SUCCESS then
  begin
    // retrieve the type and data for a specified value name
    // Den Typ und Wert des Eintrags Ermitteln.
    SetLastError(RegQueryValueEx(key,
                 PChar(ValueName),
                 nil,
                 @valueType,
                 nil,
                 @valueLen));
    if GetLastError = ERROR_SUCCESS then
      if valueType = REG_MULTI_SZ then
      begin
        GetMem(buffer, valueLen);
        try
          // receive the value's data (in an array).
          // Ein Array von Null-terminierten Strings
          // wird zurückgegeben
          RegQueryValueEx(key,
                          PChar(ValueName),
                          nil,
                          nil,
                          PBYTE(buffer),
                          @valueLen);
          // Add values to stringlist
          // Werte in String Liste einfügen
          p := buffer;
          while p^ <> #0 do
          begin
            Strings.Add(p);
            Inc(p, lstrlen(p) + 1)
          end
        finally
          FreeMem(buffer)
        end
      end
      else
        raise ERegistryException.Create('Stringlist expected/ String Liste erwartet...')
    else
      raise ERegistryException.Create('Cannot Read MULTI_SZ Value/'+
        'Kann den MULTI_SZ Wert nicht lesen...');
  end;
end;


function CompareVersion(AStrNew, AStrOld: string): Boolean;
//if AstrNew > AStrOld then return true else return false; 
var
  I: Integer;
  fListOld, fListNew: TStrings;
  fIntOld, fIntNew: Integer;
begin
//1.0.1.1 1.0.0.8
  Result := False;
  fListOld := StringToList(AstrOld, '.');
  fListNew := StringToList(AStrNew, '.');
  try
    for I := 0 to fListNew.Count - 1 do    // Iterate
    begin
      if fListOld.Count < I then Break;
      fIntOld := StrToInt(fListOld.Strings[I]);
      fIntNew := StrToInt(fListNew.Strings[I]);
      if fIntOld <> fIntNew then
      begin
        result := fIntOld < fIntNew;
        Break;
      end
    end;    // for
  finally
    fListOld.Free;
    fListNew.Free;
  end;
end;

{
function EncodeString(ASource: string; AKey: string; Encode: Boolean): string;
var
  fClipher: TCipherManager;
begin
  fClipher := TCipherManager.Create(nil);
  try
    fClipher.InitKey(AKey, nil);
    if ASource <> EmptyStr then
    begin
      if Encode then
        result := fClipher.EncodeString(ASource)
      else
        result := fClipher.DecodeString(ASource);
    end
    else
      result := EmptyStr;
  finally
    fClipher.Free;
  end;
end;

}
procedure SaveTextToClipboard(AText: WideString);
var
  fClip: TClipboard;
begin
  fClip := TClipboard.Create;
  try
    fClip.AsText := AText;
  finally
    fClip.Close;
    fClip.Free;
  end;
end;

function getFileDate(AFilename: string): TDateTime;
var
  f: TSearchRec;
  fSysTime: SYSTEMTIME;
  fFileDate: TDateTime;
begin
  if FindFirst(AFilename, faAnyFile, f) = 0 then
  begin
    FileTimeToSystemTime(f.FindData.ftLastWriteTime, fSysTime);
    fFileDate := SystemTimeToDateTime(fSysTime);
    fFileDate := IncHour(fFileDate, 8);
  end;
  FindClose(f);
  result := fFileDate;
end;

procedure UpdateWinControlEnabled(AParent: TWinControl; AEnabled: Boolean);
var
  I: Integer;
  fCount: Integer;
begin
  for I := 0 to AParent.ControlCount - 1 do    // Iterate
  begin
//    if AParent.Controls[I] is TControl then
//    begin
    AParent.Controls[I].Enabled := AEnabled;
    if AParent.Controls[I] is TWinControl then
      UpdateWinControlEnabled(TWinControl(AParent.Controls[I]), AEnabled);
//      with TControl(AParent.Controls[I]) do
//      begin
//        Enabled := AEnabled;
//        if AParent.Components[I].ComponentCount > 0 then
//          UpdateControlEnabled(AParent.Components[I], AEnabled);
//      end;    // with
//    end;
  end;    // for
end;

procedure UpdateControlEnabled(AParent: TComponent; AEnabled: Boolean);
var
  I: Integer;
  fCount: Integer;
begin
  for I := 0 to AParent.ComponentCount - 1 do    // Iterate
  begin
    if AParent.Components[I] is TControl then
    begin
      with TControl(AParent.Components[I]) do
      begin
        Enabled := AEnabled;
        if AParent.Components[I].ComponentCount > 0 then
          UpdateControlEnabled(AParent.Components[I], AEnabled);
      end;    // with
    end;
  end;    // for
end;


{procedure UpdateControlEnabled(AParent: TWinControl; AEnabled: Boolean);
var
  I: Integer;
  fCount: Integer;
begin
  for I := 0 to AParent.ControlCount - 1 do    // Iterate
  begin
//    if AParent.Components[I] is TControl then
//    begin
      with TControl(AParent.Controls[I]) do
      begin