dxstring.pas

Well known and usefull component for delphi 7

   MyCriticalSection:=nil;
   inherited Destroy;
end;

constructor TDXCritical.Create;
begin
   inherited Create;

{$IFDEF VER100}
   Synchronizer:=TCriticalSection.Create;
{$ELSE}
   Synchronizer:=TCriticalSection.Create;// TMultiReadExclusiveWriteSynchronizer.Create;
{$ENDIF}
end;

destructor TDXCritical.Destroy;
begin
   try
      Synchronizer.Free;
   except
   end;
   inherited Destroy;
end;

procedure TDXCritical.StartingRead;
begin
{$IFDEF VER100}
   Synchronizer.Acquire;
{$ELSE}
try
   Synchronizer.Acquire;//BeginRead;
except
end;
{$ENDIF}
end;

procedure TDXCritical.FinishedRead;
begin
{$IFDEF VER100}
   Synchronizer.Release;
{$ELSE}
   Synchronizer.Release;//EndRead;
{$ENDIF}
end;

procedure TDXCritical.StartingWrite;
begin
{$IFDEF VER100}
   Synchronizer.Acquire;
{$ELSE}
try
   Synchronizer.Acquire;//BeginWrite;
except
end;
{$ENDIF}
end;

procedure TDXCritical.FinishedWrite;
begin
{$IFDEF VER100}
   Synchronizer.Release;
{$ELSE}
   Synchronizer.Release;//EndWrite;
{$ENDIF}
end;

procedure FastMove(const Source; var Dest; Count : Integer);
begin
{$IFDEF USE_NEXUS_FASTMOVE}
    nxMove(Source,Dest,Count);
{$ELSE}
    System.Move(Source,Dest,Count);
{$ENDIF}
end;

///////////////////////////////////////////////////////////////////////////////
// Windows/Operating System Routines
///////////////////////////////////////////////////////////////////////////////

{$IFNDEF LINUX}
Type
  TPoint = packed record
    X: Longint;
    Y: Longint;
  end;

  TMSG = packed record
    hwnd: DWord;
    message: LongWord;
    wParam: LongInt;
    lParam: LongInt;
    time: DWORD;
    pt: TPoint;
  end;
  POverlapped = ^TOverlapped;
  _OVERLAPPED = record
    Internal: DWORD;
    InternalHigh: DWORD;
    Offset: DWORD;
    OffsetHigh: DWORD;
    hEvent: Integer;
  end;
  {$EXTERNALSYM _OVERLAPPED}
  TOverlapped = _OVERLAPPED;
  PSystemTime = ^TSystemTime;
  _SYSTEMTIME = record
    wYear: Word;
    wMonth: Word;
    wDayOfWeek: Word;
    wDay: Word;
    wHour: Word;
    wMinute: Word;
    wSecond: Word;
    wMilliseconds: Word;
  end;
  {$EXTERNALSYM _SYSTEMTIME}
  TSystemTime = _SYSTEMTIME;
  PTimeZoneInformation = ^TTimeZoneInformation;
  _TIME_ZONE_INFORMATION = record
    Bias: Longint;
    StandardName: array[0..31] of WideChar;
    StandardDate: TSystemTime;
    StandardBias: Longint;
    DaylightName: array[0..31] of WideChar;
    DaylightDate: TSystemTime;
    DaylightBias: Longint;
  end;
  {$EXTERNALSYM _TIME_ZONE_INFORMATION}
  TTimeZoneInformation = _TIME_ZONE_INFORMATION;

function PeekMessage(var lpMsg: TMsg; hWnd: DWord;
  wMsgFilterMin, wMsgFilterMax, wRemoveMsg: LongWord): LongBOOL; stdcall;
external 'user32.dll' name 'PeekMessageA';
function TranslateMessage(const lpMsg: TMsg): LongBOOL; stdcall;
external 'user32.dll' name 'TranslateMessage';
function DispatchMessage(const lpMsg: TMsg): Longint; stdcall;
external 'user32.dll' name 'DispatchMessageA';
function WriteFile(hFile: Integer; const Buffer; nNumberOfBytesToWrite: DWORD;
  var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): LongBOOL; stdcall;
external 'kernel32.dll' name 'WriteFile';
function MessageBox(hWnd: DWord; lpText, lpCaption: PChar; uType: LongWord): Integer; stdcall;
external 'user32.dll' name 'MessageBoxA';
function SleepEx(dwMilliseconds: DWORD; bAlertable: LongBOOL): DWORD; stdcall;
external 'kernel32.dll' name 'SleepEx';
function WinExec(lpCmdLine: PAnsiChar; uCmdShow: LongWord): LongWord; stdcall;
external 'kernel32.dll' name 'WinExec';
function GetTimeZoneInformation(var lpTimeZoneInformation: TTimeZoneInformation): DWORD; stdcall;
external 'kernel32.dll' name 'GetTimeZoneInformation';
function GetFullPathName(lpFileName: PChar; nBufferLength: DWORD;
  lpBuffer: PChar; var lpFilePart: PChar): DWORD; stdcall;
external 'kernel32.dll' name 'GetFullPathNameA';
function GetDateFormat(Locale: DWord; dwFlags: DWORD; lpDate: PSystemTime;
  lpFormat: PChar; lpDateStr: PChar; cchDate: Integer): Integer; stdcall;
external 'kernel32.dll' name 'GetDateFormatA';
function GetThreadLocale: DWord; stdcall;
external 'kernel32.dll' name 'GetThreadLocale';
function CharNext(lpsz: PChar): PChar; stdcall;
external 'user32.dll' name 'CharNextA';
function WinGetUserName(lpBuffer: PChar; var nSize: DWORD): LongBOOL; stdcall;
external 'advapi32.dll' name 'GetUserNameA';
function WinGetComputerName(lpBuffer: PChar; var nSize: DWORD): LongBOOL; stdcall;
external 'kernel32.dll' name 'GetComputerNameA';
function GetTempPath(nBufferLength: DWORD; lpBuffer: PChar): DWORD; stdcall;
external 'kernel32.dll' name 'GetTempPathA';
function GetTempFileName(lpPathName, lpPrefixString: PChar;
  uUnique: LongWord; lpTempFileName: PChar): LongWord; stdcall;
external 'kernel32.dll' name 'GetTempFileNameA';
{$ENDIF}

procedure ProcessWindowsMessageQueue;
{$IFDEF LINUX}
begin
   Application.ProcessMessages;
end;
{$ELSE}
var
   MsgRec:TMsg;

begin
   if not IsConsole then
      while PeekMessage(MsgRec,0,0,0,1) do begin
         TranslateMessage(MsgRec);
         DispatchMessage(MsgRec)
      end;
end;
{$ENDIF}

function HiByteOfWord(const W:Word):Byte;
begin
   Result:=Hi(W);
end;

function MakeBytesToWord(const A,B:Byte):Word;
begin
   Result:=(A shl 8)+B;
end;

function WindowsWriteFile(hFile:Integer;const Buffer;nNumberOfBytesToWrite:DWORD;
   var lpNumberOfBytesWritten:DWORD):Boolean;
begin
{$IFDEF LINUX}
   lpNumberOfBytesWritten:=FileWrite(hFile,Buffer,nNumberOfBytesToWrite);
   Result:=lpNumberOfBytesWritten=nNumberOfBytesToWrite;
{$ELSE}
   Result:=WriteFile(hFile,Buffer,nNumberOfBytesToWrite,lpNumberOfBytesWritten,nil);
{$ENDIF}
end;

procedure ShowMessageWindow(const Caption,Message:string);
begin
{$IFDEF LINUX}
   MessageDlg(Caption,Message,mtError, [mbOk],0);
{$ELSE}
   MessageBox(0,PChar(Message),PChar(Caption),$00000030 or $00001000 { $00002000});
{$ENDIF}
end;

procedure DoSleepEX(const Interval:DWord);
begin
{$IFDEF LINUX}
   Sleep(Interval);
{$ELSE}
   SleepEx(Interval,False{True});
{$ENDIF}
end;

{$IFNDEF LINUX}
function RegistryStringGet(const Key:HKey;SubKey:string):string;
var
   Reg:TRegistry;
   lResult:string;
   DValue:string;

begin
   lResult:='';
   DValue:=SubKey;
   Delete(DValue,1,PosLastChar('\',SubKey));
   Delete(SubKey,PosLastChar('\',SubKey),length(DValue)+1);
   Reg:=TRegistry.Create;
   try
      Reg.RootKey:=Key;
      if Reg.OpenKey(SubKey,True) then
         lresult:=Reg.ReadString(DValue);
   finally
      Reg.CloseKey;
      Reg.Free;
   end;
   result:=lresult;
end;

function RegistryStringSet(const Key:HKey;SubKey,Value:string):Boolean;
var
   Reg:TRegistry;
   DValue:string;

begin
   DValue:=SubKey;
   Delete(DValue,1,PosLastChar('\',SubKey));
   Delete(SubKey,PosLastChar('\',SubKey),length(DValue)+1);
   Reg:=TRegistry.Create;
   Result:=False;
   try
      Reg.RootKey:=Key;
      if Reg.OpenKey(SubKey,True) then begin
         Reg.WriteString(DValue,Value);
         Result:=True;
      end;
   finally
      Reg.CloseKey;
      Reg.Free;
   end;
end;

function GetRegistryString(const Key:HKey;const SubKey:string):string;
begin
   Result:=RegistryStringGet(Key,SubKey);
end;

function SetRegistryString(const Key:HKey;SubKey,Value:string):Boolean;
begin
   Result:=RegistryStringSet(Key,SubKey,Value);
end;

function LaunchWebBrowser(const URL:string;const WindowState:Integer):Boolean;
Const
  HKEY_CLASSES_ROOT     = DWORD($80000000);

var
   sLaunch:string;
   iPos:integer;

begin
   Result:=False;
   sLaunch:=GetRegistryString(HKEY_CLASSES_ROOT,'.htm');
   if sLaunch<>'' then begin
      sLaunch:=sLaunch+'\shell\open\command';
      sLaunch:=GetRegistryString(HKEY_CLASSES_ROOT,sLaunch);
      if sLaunch<>'' then begin
         iPos:=QuickPos('"%1"',sLaunch);
         if iPos=0 then iPos:=QuickPos('%1',sLaunch);
         if iPos<>0 then sLaunch:=Copy(sLaunch,1,iPos-1);
         sLaunch:=sLaunch+#32+URL;
         Result:=WinExec(PChar(sLaunch),WindowState)>31;
      end;
   end;
end;
{$ENDIF}

{$IFNDEF VER90}
///////////////////////////////////////////////////////////////////////////////
// References the external symbol to MS CoCreateGUID function which creates MS-style UUID's
///////////////////////////////////////////////////////////////////////////////
{$IFNDEF LINUX}
function CoCreateGuid;external ole32 name'CoCreateGuid';
{$ENDIF}

function MakeUUID:string;
var
   UUIDVar:TGUID;
   UUID_String:string;
   k:Integer;

begin
   CoCreateGuid(UUIDVar);
   UUID_String:=IntToHex(UUIDVar.D1,8)+'-'+
      IntToHex(UUIDVar.D2,4)+'-'+
      IntToHex(UUIDVar.D3,4)+'-';
   for k:=0 to 1 do
      UUID_String:=UUID_String+IntToHex(UUIDVar.D4[k],2);
   UUID_String:=UUID_String+'-';
   for k:=2 to 7 do
      UUID_String:=UUID_String+IntToHex(UUIDVar.D4[k],2);
   Result:=UUID_String;
end;

function RawUUID:string;
var
   UUIDVar:TGUID;
   UUID_String:string;
   k:Integer;

begin
   CoCreateGuid(UUIDVar);
   UUID_String:=IntToHex(UUIDVar.D1,8)+
      IntToHex(UUIDVar.D2,4)+
      IntToHex(UUIDVar.D3,4);
   for k:=0 to 1 do
      UUID_String:=UUID_String+IntToHex(UUIDVar.D4[k],2);
   for k:=2 to 7 do
      UUID_String:=UUID_String+IntToHex(UUIDVar.D4[k],2);
   Result:=UUID_String;
end;

function MakeUUIDPacked:string;
var
   UUIDVar:TGUID;

begin
   CoCreateGuid(UUIDVar);
   SetLength(Result,16);
   FastMove(UUIDVar.D1,Result[1],4);
   FastMove(UUIDVar.D2,Result[5],2);
   FastMove(UUIDVar.D3,Result[7],2);
   FastMove(UUIDVar.D4,Result[9],8);
end;
{$ENDIF}

{$IFDEF LINUX}
function CoCreateGuid(var GUID:TGUID):HResult;
begin
   Result:=CreateGUID(GUID);
end;
{$ENDIF}

///////////////////////////////////////////////////////////////////////////////
// Numeric Routines
///////////////////////////////////////////////////////////////////////////////

function IsCharAlphaNumeric(const C:char):Boolean;
begin
{$IFNDEF ASM8086}
   Result:=C in ['0'..'9','A'..'Z','a'..'z'];
{$ELSE}
   asm
   mov AL,C
   cmp AL, $30   // 0
   jl @NoMatch   // it's before '0' so Result=False/Exit
   cmp AL, $7A   // z
   jg @NoMatch   // it's after 'z' so Result=False/Exit
   cmp AL, $39   // 9
   jg @TryAlpha  // it's after '9' so see if it is Alpha now
   jmp @Matched  // it's 0..9 so Result=True/Exit
@TryAlpha:
   cmp AL, $41   // A
   jl @NoMatch   // it's before 'A' so Result=False/Exit
   cmp AL, $5A   // Z
   jg @TryLower  // it's after 'Z' so see if it is lowecase Alpha
   jmp @Matched  // it's 'A'..'Z' so Result=True/Exit
@TryLower:
   cmp AL, $61   // a
   jl @NoMatch   // it's before 'a' so Result=False/Exit
   jmp @Matched  // it's 'a'..'z' so Result=True/Exit
@NoMatch:
   mov Result,0
   jmp @TheEnd
@Matched:
   mov Result,1
@TheEnd:
   end{asm}
{$ENDIF}
   end;

function IsCharAlpha(const c:Char):Boolean;
begin
{$IFNDEF ASM8086}
   Result:=C in ['A'..'Z','a'..'z'];
{$ELSE}
   asm
   mov AL,C
   cmp AL, $41   // A
   jl @NoMatch   // it's before 'A' so Result=False/Exit
   cmp AL, $7A   // z
   jg @NoMatch   // it's after 'z' so Result=False/Exit
   cmp AL, $5A   // Z
   jg @TryLower  // it's after 'Z' so see if it is lower now
   jmp @Matched  // it's A..Z so Result=True/Exit
@TryLower:
   cmp AL, $61   // a
   jl @NoMatch   // it's before 'a' so Result=False/Exit
   jmp @Matched  // it's 'a'..'z' so Result=True/Exit
@NoMatch:
   mov Result,0
   jmp @TheEnd
@Matched:
   mov Result,1
@TheEnd:
   end{asm}
{$ENDIF}
   end;

function IsNumeric(const c:char):Boolean;
begin
{$IFNDEF ASM8086}
   Result:=IsCharAlphaNumeric(c)and not IsCharAlpha(c);
{$ELSE}
   asm
   mov AL,C
   cmp AL, $30   // 0
   jl @NoMatch   // it's before '0' so Result=False/Exit
   cmp AL, $39   // 9
   jg @NoMatch   // it's after '9' so Result=False/Exit
   jmp @Matched  // it's 0..9 so Result=True/Exit
@NoMatch:
   mov Result,0