X000X-SysUtils.pas

X000X-SysUtils.pas

Ich habe hier mal ein paar ältere Delphi sourcen eingearbeitet. Die Originale findet Ihr immer noch hier:

X000XBtn.pas
X000XSysUtils.pas
X000XActiveX.pas



unit X000XSysUtils;

interface

Uses Windows;

   procedure ShowMessage(const szMessage: String);
   function FileExists(const szFileName: String): Boolean;
   procedure WriteDebug(const szStr: String; const Param : Boolean);
   function UpperCase(const s: String): String;
   function LowerCase(const s: String): String;
   function IntToStr(const i: Int64): string;
   function Format(fmt: string; params: array of const): string;
   procedure FreeAndNil(var Obj);

implementation

procedure ShowMessage(const szMessage: String);
begin
   MessageBox(0, Pointer(szMessage), 'InfoBox', 0);
end;

function FileExists(const szFileName: String): Boolean;
var
   Handle   : THandle;
   FindData : TWin32FindData;
begin
   Handle   := FindFirstFile(Pointer(szFileName),FindData);
   Result   := (Handle <> INVALID_HANDLE_VALUE);

   if(Result) then Windows.FindClose(Handle);
end;

procedure WriteDebug(const szStr: String; const Param : Boolean);
var
   F    : TextFile;
   Attr : DWord;
const FName = 'debug.txt';
begin
   if Param then begin
      AssignFile(F, FName);
      Attr := GetFileAttributes(FName);
      if ((Attr and FILE_ATTRIBUTE_DIRECTORY	) = FILE_ATTRIBUTE_DIRECTORY) and
         Not ((Attr = $FFFFFFFF)) then
         Exit;
      if (Attr = $FFFFFFFF) then
         ReWrite(F)
      else
         Append(F);
      WriteLn(F, IntToStr(GetTickCount div 1000) + ': ' + szStr);
      Flush(F);
      CloseFile(F);
   end;
end;

function UpperCase(const s: String): String;
var i : Integer;
begin
   Result := '';

   if(length(s) > 0) then begin
      SetLength(Result,length(s));
      for i := 1 to length(s) do
         Result[i] := UpCase(s[i]);
   end;
end;

function LowerCase(const s: String): String;
var i : Integer;
begin
   Result := '';

   if(length(s) > 0) then begin
      SetLength(Result,length(s));
      for i := 1 to length(s) do
         case s[i] of
            'A'..'Z','�','�','�':
               Result[i] := CHR(BYTE(s[i]) + 32);
         else
            Result[i] := s[i];
         end;
   end;
end;

function IntToStr(const i: Int64): string;
var
  Negativ : Boolean;
  Dummy   : Int64;
begin
   Result := '';
   Dummy  := i;
   if Dummy = 0 then
      Result := '0';
   Negativ := Dummy < 0;
   if Negativ then
      Dummy := -Dummy;
   while Dummy > 0 do
   begin
      Result := Char((Dummy mod 10) + Integer('0')) + Result;
      Dummy := Dummy div 10;
   end;
   if Negativ then
      Result := '-' + Result;
end;

function Format(fmt: string; params: array of const): string;
var
   pdw1, pdw2: PDWORD;
   i: integer;
   pc: PCHAR;
begin
   pdw1 := nil;
   if length(params) > 0 then
      GetMem(pdw1, length(params) * sizeof(Pointer));
   pdw2 := pdw1;
   for i := 0 to high(params) do begin
      pdw2^ := DWORD(PDWORD(@params[i])^);
      inc(pdw2);
   end;
   GetMem(pc, 1024 - 1);
   try
      SetString(Result, pc, wvsprintf(pc, PCHAR(fmt), PCHAR(pdw1)));
   except
      Result := '';
   end;
   if (pdw1 <> nil) then
      FreeMem(pdw1);
   if (pc <> nil) then
      FreeMem(pc);
end;

procedure FreeAndNil(var Obj);
var
  Temp: TObject;
begin
  Temp := TObject(Obj);
  Pointer(Obj) := nil;
  Temp.Free;
end;

end.

Gefallen Euch meine sourcen – freue ich mich über Eure Spende – Danke!





Comments are closed.