myutils.pas

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

        Enabled := AEnabled;
        if TWinControl(AParent.Controls[I]).ControlCount > 0 then
          UpdateControlEnabled(TWinControl(AParent.Controls[I]), AEnabled);
      end;    // with
//    end;
  end;    // for
end;
}

function ListToString(AList: TStrings; Splitter: string): string;
begin
  result := stringReplace(AList.Text, sLineBreak, Splitter, [rfReplaceAll]);
  if Copy(result, Length(result), 1) = Splitter then
    result := Copy(result, 0, Length(result) - 1);
end;

function StringToList(AText: string; Splitter: string): TStrings;
begin
  result := TStringList.Create;
  result.Text := StringReplace(AText, Splitter, sLineBreak, [rfReplaceAll]);
end;

function GetNewGUID: string;
begin
  result := CreateClassID;
end;
   
function ToString(Value: Variant): string;
begin
  case VarType(Value) of    //
    varSmallint, varInteger, varSingle, varDouble, varCurrency:
      result := IntToStr(Value);
    varDate: result := DateTimeToStr(Value);
    varBoolean: result := IntToStr(Ord(Boolean(Value)));
    else result := VarToStr(Value);
  end;    // case
end;

function ReadRegistryValue(Root: HKEY; Path: string; Name: string;
   VarType: TVarType): Variant;
begin
  with TRegistry.Create do
  begin
    try
      RootKey := Root;
      if OpenKey(Path, False) then
      begin
        case VarType of    //
          varSmallint, varInteger, varSingle, varDouble, varCurrency:
           result := ReadInteger(Name);
          varDate: result := ReadDateTime(Name);
          varBoolean: result := ReadBool(Name)
          else result := ReadString(Name);
        end;    // case
//        Result := ReadString(Name);
      end;        
    finally // wrap up
      CloseKey;
      Free;
    end;    // try/finally
  end;    // with
end;

procedure DeleteRegistryValue(Root: HKEY; Path: string; Name: string);
begin
  with TRegistry.Create do
  begin
    try
      RootKey := Root;
      if OpenKey(Path, False) then
      begin
        if ValueExists(Name) then
          DeleteValue(Name);
      end;
    finally // wrap up
      CloseKey;
      Free;
    end;    // try/finally
  end;    // with
end;

function WriteRegistryValue(Root: HKEY; Path: string; Name: string;
  Value: Variant): Boolean;
begin
  result := False;
  with TRegistry.Create do
  begin
    try
      RootKey := Root;
      if OpenKey(Path, True) then
      begin
        case VarType(Value) of
          varSmallint, varInteger, varSingle, varDouble, varCurrency:
            WriteInteger(Name, Value);
          varDate: WriteDateTime(Name, Value);
          varBoolean: WriteBool(Name, Value)
          else WriteString(Name, Value);
        end;
        Result := True;
      end;
    finally // wrap up
      CloseKey;
      Free;
    end;    // try/finally
  end;    // with
end;


function ShowBox(Text: string; BoxType: Integer; CheckForLog: Boolean = false): Integer;
var
  fHandle: THandle;
  fText: string;
const
  sMaxLen = 300;
  sPromptViewLog = '%s....' + sLineBreak + ',要查看日志吗？';
begin
  if Screen.ActiveForm <> nil then
    fHandle := Screen.ActiveForm.Handle
  else
    fHandle := Application.Handle;
  if CheckForLog and (Length(Text) > sMaxLen) then
  begin
    fText := Format(sPromptViewlog, [Copy(Text, 0 ,sMaxLen)]);
    result := MessageBox(fHandle, PChar(fText), PChar(Application.Title),
        MB_YESNO + MB_ICONERROR);
    if result = IDYES then
      ShowDefaultApplogFile;
    Exit;
  end;
  Result := MessageBox(fHandle,
    PChar(Text), PChar(Application.Title), BoxType);
end;

function ShowBox(Text: string; CheckForLog: Boolean = false): Integer;
begin
  Result := ShowBox(Text, MB_OK + MB_ICONINFORMATION, CheckForLog);
end;

function ShowBox(FormatText: string; Avgs: array of const; BoxType: Integer;
  CheckForLog: Boolean = false):  Integer;
begin
  Result := ShowBox(Format(FormatText, Avgs), BoxType, CheckForLog);
end;

procedure ShowErrorBox(Text: string; CheckForLog: Boolean = false);
begin
  ShowBox(Text, MB_OK + MB_ICONSTOP, CheckForLog);
end;

procedure ShowErrorBox(FormatText: string; Avgs: array of const;
  CheckForLog: Boolean = false);
begin
  ShowErrorBox(Format(FormatText, Avgs), CheckForLog);
end;


procedure ExecuteApp(FileName: string; RunPath: string = '';
  ShowCmd: Integer = SW_SHOWNORMAL);
begin
  ShellExecute(0, 'open', PChar(FileName), '', PChar(RunPath), ShowCmd);
end;


procedure ShowDefaultApplogFile;
var
  FLogFileName: string;
begin
  FLogFileName := ChangeFileExt(GetModuleName(hInstance), '.log');
  if FileExists(FLogFileName) then
  begin
    ExecuteApp(FLogFileName, '');
  end;
end;


function GetLocalIP: WideString;
var
  LocalStack: TIdStack;
begin
  LocalStack := TIdStack.CreateStack;
  try
    try
      Result := LocalStack.LocalAddress;
    except
    	on e: Exception do
        result := 'Unknown IP';
    end;  // try/except
  finally
    LocalStack.Free;
  end;
end;

function GetMachineName: WideString;
begin
  SetLength(result, 250);
  GetHostName(PChar(result), Length(result));
  Result := String(PChar(result));
end;

function CompressString(Source: WideString; AddLog: Boolean): WideString;
var
  fStr: TStringStream;
  fCompress: TCompressionStream;
  fMemStream: TMemoryStream;
begin
  if AddLog then
    AppLogger.AddLog(Application, '正在压缩...', logInfo);
  fStr :=  TStringStream.Create(Source);
  fMemStream := TMemoryStream.Create;
  fCompress := TCompressionStream.Create(clMax, fMemStream);
  try
    try
      fCompress.CopyFrom(fStr, 0);
    finally
    	// free resources
      fCompress.Free;
    end;  // try/finally
    fMemStream.Position := 0;
    result := Base64Encode(fMemStream) ;
  finally // wrap up
    fMemStream.Free;
    fStr.Free;
  end;    // try/finally
  if AddLog then
    AppLogger.AddLog(Application, '压缩完成[ %d(压缩前) / %d(压缩后)字节]...',
      [Length(Source), Length(result)], logInfo);
end;


function DeCompressString(Source: WideString; AddLog: Boolean): WideString;
var
//  fStr: TStringStream;
  fDeCompress: TDeCompressionStream;
  fMemStream: TMemoryStream;
  fData: TStringStream;
  fBufferLen: Integer;
  fBuffer: array[0..65535] of byte;
begin
  if AddLog then
    AppLogger.AddLog(Application, '正在解压缩...', logInfo);
  fData := TStringStream.Create('');
  fMemStream := Base64Decode(Source);
  fMemStream.Position := 0;
  fDeCompress := TDeCompressionStream.Create(fMemStream);
  try
    try
      fBufferLen := fDeCompress.Read(fBuffer, SizeOf(fBuffer));
      while fBufferLen > 0 do
      begin
        fData.WriteBuffer(fBuffer, fBufferLen);
        fBufferLen := fDeCompress.Read(fBuffer, SizeOf(fBuffer));
      end;    // while
    finally
    	// free resources
      fDeCompress.Free;
    end;  // try/finally
    fData.Position := 0;
    Result := fData.DataString;
//    setLength(result, fData.size);
//    Move(fData.Memory^, result[1], fData.Size);
  finally // wrap up
    fMemStream.Free;
    fData.Free;
  end;    // try/finally
  if AddLog then
    AppLogger.AddLog(Application, '解压缩完成[ %d(解压前) / %d(解压后)字节 ] ...',
      [Length(Source), Length(result)], logInfo);
end;

function Base64Encode(Source: TStream) : WideString;
var
  fEncode: TIdEncoderMIME;
begin
  fEncode := TIdEncoderMIME.Create(nil);
  try
    result := fEncode.Encode(Source) ;
  finally
  	// free resources
    fEncode.Free;
  end;  // try/finally
end;

function Base64Decode(Source: WideString): TMemoryStream;
var
  fDecode: TIdDecoderMIME;
begin
  result := TMemoryStream.Create;
  fDecode := TIdDecoderMIME.Create(nil);
  try
    fDecode.DecodeToStream(Source, result);
  finally
  	// free resources
    fDecode.Free;
  end;  // try/finally
end;

function GetAppVersion: string;
begin
  with AppVerInfo do
  begin
    result := ProductVersion;
    Free;
  end;    // with
end;


function GetAppFileVersion: string;
begin
  with AppVerInfo do
  begin
    result := FileVersion;
    Free;
  end;    // with
end;


function GetAppProductName: string;
begin
  with AppVerInfo do
  begin
    result := ProductName;
    Free;
  end;    // withend;
end;


function GetLock: TCriticalSection;
begin
  result := TCriticalSection.Create;
end;

const
  sDateFormat = 'yyyy-mm-dd hh:nn:ss';
procedure LogTextToFile(Sender: TObject; AFileName, AText: string;
  ShowDate: Boolean = True);
var
  varFile: TextFile;
  fText: string;
  fSenderName: string;
begin
  try
    try
      AssignFile(varFile, AFileName);
      if not FileExists(AFileName) then
        ReWrite(varFile);
      Append(varFile);
      if Sender <> nil then
        fSenderName := Sender.ClassName
      else
        fSenderName := Application.ClassName;
        
      if ShowDate then
        fText := Format('[%s][%s]%s', [
          FormatDateTime(sDateFormat, Now), fSenderName, AText  ])
      else
        fText := Format('[%s]%s',[fSenderName, AText]);
      WriteLn(varFile, fText);
    except
    end;  { try/except }
  finally
   { free resources }
    CloseFile(varFile);
  end;  { try/finally }
  if Assigned(GlobalOnAppLog) then
    GlobalOnAppLog(Sender, fText);
end;

procedure DefaultAppLog(Sender: TObject; AText: string);
var
  fLogFileName: string;
begin
  fLogFileName := GetDefaultAppLogFileName;
  LogTextToFile(Sender, fLogFileName, AText, True);
end;

function GetDefaultAppLogFileName: string;
begin
  result := ChangeFileExt(GetModuleName(hInstance), '.log');
end;

function GetMACAddress: WideString;
var
  NCB: PNCB;
  Adapter: PAdapterStatus;
  URetCode: PChar;
  RetCode: Char;
  I: Integer;
  Lenum: PlanaEnum;
  _SystemID: string;
  TMPSTR: string;
begin
  Result    := '';
  _SystemID := '';
  Getmem(NCB, SizeOf(TNCB));
  Fillchar(NCB^, SizeOf(TNCB), 0);
  
  Getmem(Lenum, SizeOf(TLanaEnum));
  Fillchar(Lenum^, SizeOf(TLanaEnum), 0);
  
  Getmem(Adapter, SizeOf(TAdapterStatus));
  Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);
  
  Lenum.Length    := chr(0);
  NCB.ncb_command := chr(NCBENUM);
  NCB.ncb_buffer  := Pointer(Lenum);
  NCB.ncb_length  := SizeOf(Lenum);
  RetCode         := Netbios(NCB);
  
  i := 0;
  repeat
    Fillchar(NCB^, SizeOf(TNCB), 0);
    Ncb.ncb_command  := chr(NCBRESET);
    Ncb.ncb_lana_num := lenum.lana[I];
    RetCode          := Netbios(Ncb);
  
    Fillchar(NCB^, SizeOf(TNCB), 0);
    Ncb.ncb_command  := chr(NCBASTAT);
    Ncb.ncb_lana_num := lenum.lana[I];
    // Must be 16
    Ncb.ncb_callname := '*               ';
  
    Ncb.ncb_buffer := Pointer(Adapter);
  
    Ncb.ncb_length := SizeOf(TAdapterStatus);
    RetCode        := Netbios(Ncb);
    //---- calc _systemId from mac-address[2-5] XOR mac-address[1]...
    if (RetCode = chr(0)) or (RetCode = chr(6)) then
    begin
      _SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +
        IntToHex(Ord(Adapter.adapter_address[5]), 2);
    end;
    Inc(i);
  until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');
  FreeMem(NCB);
  FreeMem(Adapter);
  FreeMem(Lenum);
  result := _SystemID;
  
  result := StringReplace(result, '-', '', [rfReplaceAll]);

  if result= EmptyStr then
    result := GetLocalIP;
end;


end.