delphi4arab منتديات دلفي للعرب

الصفحات : 1 2

لمعرفة حالة Service

PHP كود :
uses
  Winapi.Windows, WinSvc;

function ServiceGetStatus(sMachine, sService: string ): DWord;
var
  schm,
  schs : SC_Handle;
  ss : TServiceStatus;
  dwStat : DWord;
begin
    dwStat := 0;

    schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);

    if (schm > 0) then
    begin
        schs := OpenService(schm, PChar(sService), SERVICE_QUERY_STATUS);

        if (schs > 0) then
        begin
            if (QueryServiceStatus(schs, ss)) then
            begin
                dwStat := ss.dwCurrentState;
            end;
            CloseServiceHandle(schs);
        end;
        CloseServiceHandle(schm);
    end;
    Result := dwStat;
end; 

لمعرفة اذا كان FireBird شغال باستخدام الدالة اعلاه

PHP كود :
function IsFirebirdRunning:boolean;
begin
  Result:=(ServiceGetStatus('','FirebirdServerDefaultInstance') = SERVICE_RUNNING);
end; 

لمعرفة مكان تنصيب الـ FireBird

PHP كود :
uses
  System.Win.Registry;

function GetFireBirdLocation: string;
var
  Reg : TRegistry;
  Str : String;
begin
  Result := '';
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('Software\Firebird Project\Firebird Server\Instances', False) then
      Result := Reg.ReadString('DefaultInstance');
  Finally
    Reg.CloseKey;
    FreeAndNil(Reg);
  End;
end; 

خاصية لجلب مسار المجلد Temp

PHP كود :
Function GetTempFolderPath : String;
begin
  Result := GetEnvironmentVariable('TEMP');
end; 

خاصية لجلب ايبي موقع واب

PHP كود :
Function GetWebSiteIPAddress(Const WebSiteUrl: String): String;
var
  Socket_data: TWSAData;
  Socket1: PHostEnt;
  Socket2: TInAddr;
begin
  WSAStartup($101, socket_data);
  Socket1 := Winapi.WinSock.Gethostbyname(PAnsiChar(AnsiString(WebSiteUrl)));
  Socket2 := PInAddr(Socket1^.h_addr_list^)^;
  Result := Winapi.WinSock.Inet_ntoa(Socket2);
end; 

طريقة الاستعمال :
اضافة الوحدة Winapi.Winsock

PHP كود :
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetWebSiteIPAddress('www.google.com'));
end; 

السلام عليكم
هذه قديمة لا اتذكر من اين نسختها

PHP كود :
function IntToHex8(Inp : DWord): String;
const FmtStr : PChar = '%8.8X'#0;
var   OutStr : array[0..9] of Char;
begin
  asm
    push  Inp
    push  FmtStr;
    lea   eax, OutStr[0]
    push  eax
    call  wsprintfA
    add   esp, 4*3
  end;
  Result := String(OutStr);
end; 

PHP كود :
function Hex8ToInt(Hex8 : String): DWord;
var Code : Integer;
begin
  if Hex8[1] = '$' then Delete(Hex8, 1, 1);
  while Hex8[1] = '0' do Delete(Hex8, 1, 1);
  Val('$' + Hex8, Result, Code);
  if Code <> 0 then Result := 0;
end; 

PHP كود :
function StringToDec(s:string) : string;
var t : integer;
begin
  result := '';
  for t := 1 to length(s) do begin
    if t = length(s) then
      result := result + intToStr(ord(s[t]))
    else
      result := result + IntToStr(ord(s[t])) + ' ';
  end;
end; 

PHP كود :
function StringToHex(Text: String): String; 
var i: Integer; 
begin 
Result := ''; 
for i := 1 to Length(Text) do 
Result := Result + IntToHex(Ord(Text[i]), 2); 
end; 

PHP كود :
function HexToInt(HexStr : string) : Int64;
var RetVar : Int64;
    i : byte;
begin
  HexStr := UpperCase(HexStr);
  if HexStr[length(HexStr)] = 'H' then
     Delete(HexStr,length(HexStr),1);
  RetVar := 0;
  
  for i := 1 to length(HexStr) do begin
      RetVar := RetVar shl 4;
      if HexStr[i] in ['0'..'9'] then
         RetVar := RetVar + (byte(HexStr[i]) - 48)
      else
         if HexStr[i] in ['A'..'F'] then
            RetVar := RetVar + (byte(HexStr[i]) - 55)
         else begin
            Retvar := 0;
            break;
         end;
  end;
  
  Result := RetVar;
end; 

PHP كود :
function IntToBin(IValue : Int64; NumBits : word = 64) : string;
var RetVar : string;
    i,ILen : byte;
begin
RetVar := '';

case NumBits of
      32 : IValue := dword(IValue);
      16 : IValue := word(IValue);
      8  : IValue := byte(IValue);
end;

while IValue <> 0 do begin
    Retvar := char(48 + (IValue and 1)) + RetVar;
    IValue := IValue shr 1;
end;

if RetVar = '' then Retvar := '0';
Result := RetVar;
end; 

PHP كود :
function BinToInt(BinStr : string) : Int64;
var i : byte;
    RetVar : Int64;
begin
   BinStr := UpperCase(BinStr);
   if BinStr[length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);
   RetVar := 0;
   for i := 1 to length(BinStr) do begin
     if not (BinStr[i] in ['0','1']) then begin
        RetVar := 0;
        Break;
     end;
     RetVar := (RetVar shl 1) + (byte(BinStr[i]) and 1) ;
   end;
  
   Result := RetVar;
end; 

PHP كود :
function ByteToHex(Value: Integer): string;
const F: PChar = '%02x'#0;
var   Res: PChar;
begin
  GetMem(Res, 3);
  asm
    push Value
    push F
    push Res
    call wsprintf
    add esp, 0Ch
  end;
  Result:= String(Res);
  FreeMem(Res);
end; 

الصفحات : 1 2

delphi4arab منتديات دلفي للعرب

S.FATEH

AX302

محمد عبد العزيز