usoporte.pas
资源名称:DarkMoon.rar [点击查看]
上传用户:hndmjx
上传日期:2014-09-16
资源大小:3369k
文件大小:13k
源码类别:
Delphi控件源码
开发平台:
Delphi
- ////////////////////////////////////////////////////////////////////////////////
- /////////////esta es mi SysUtils////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////
- unit USoporte;
- interface
- uses winsock, windows;
- var whandle : Thandle;
- //{$EXTERNALSYM WSAIoctl}
- function WSAIoctl( hSocket: TSocket; ControlCode:dword;
- InBuf : Pointer; InBufLen:DWord;
- OutBuf : Pointer; OutBufLen:DWord;
- BytesReturned : PDWord;
- lpOverlapped: POverlapped;
- lpOverlappedRoutine:pointer) : Integer; stdcall;
- //{$EXTERNALSYM WSASocket}
- function WSASocket(Family, sType, Protocol : Integer;
- lpProtocolInfo : Pointer;
- Group : uint;
- dwFlags : DWORD): TSocket; stdcall;
- function WSAIoctl; external 'ws2_32.dll' name 'WSAIoctl';
- function WSASocket; external 'ws2_32.dll' name 'WSASocketA';
- function Encriptar(const S: String ): String;
- function Desencriptar( S: String ): String;
- procedure showm( s : String );
- function GetCPUSpeed: real;
- procedure CrearStats;
- function FileExists( s : String ): Boolean;
- function StrToInt64(const S: string): Int64;
- function BuffToStr( const b : Array of Char ) : string;
- function StrToInt(const S: string ): Integer;
- function IntToStr(Value: Integer): string;
- function StrPCopy(Dest: PChar; const Source: string): PChar;
- function LowerCase(const S: string): string;
- function SigFrmToStr(Value: Integer; FormatStr : PChar): string;
- function UnSigFrmToStr(Value: Cardinal; FormatStr : PChar): string;
- function StrToIntDef(const S: string; Default: Integer): Integer;
- function Trim(const S: string): string;
- function UpperCase( S :String ): String ;
- function Time : string;
- function Date : string;
- function stringtochar(st : string) : char;
- function HexToInt(s: string): Longword;
- function GenerarRandomString: String;
- function Ocurrencias( const ss, s: String ): Integer;
- procedure PresionarTecla( key: Byte );
- procedure Contestar( UDP : TSocket; cli : TsockAddr; S : String; tcp: Integer );
- implementation
- 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;
- function GenerarRandomString: String;
- 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;
- 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 LocalIP:String;
- function ip: String;
- type TaPInAddr = array [0..10] of PInAddr;
- PaPInAddr = ^TaPInAddr;
- var phe : PHostEnt;
- pptr : PaPInAddr;
- Buffer : array [0..63] of char;
- i : Integer;
- begin
- 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;
- end;
- Type
- _INTERFACE_INFO = record
- iiFlags : ulong; //* Type and status of the interface */
- iiAddress : TSockaddr; //* Interface address */
- iiBroadcastAddress : TSockaddr; //* Broadcast address */
- iiNetmask : TSockaddr; //* Network mask */
- end;
- const SIO_GET_INTERFACE_LIST : dword = 1074033791;
- var pAddrInet : TSockAddr;
- OutBufLen, RecvBytes : DWORD;
- wsError: Integer;
- MySocket : TSocket;
- localAddr : Array[1..10] of _INTERFACE_INFO; //up to 10 NICs
- begin
- MySocket := WSASocket(AF_INET, Sock_DGRAM, IPPROTO_UDP, nil,0,0);
- if MySocket = INVALID_SOCKET then
- exit;
- OutBufLen := Sizeof(localAddr);
- RecvBytes := OutBufLen;
- FillChar(LocalAddr,OutBufLen,0);
- wsError := WSAIoctl(MySocket,SIO_GET_INTERFACE_LIST,nil,0,@localAddr,OutBufLen,@RecvBytes,nil,nil);
- if wsError = SOCKET_ERROR then
- exit;
- try pAddrInet := localAddr[1].iiAddress;
- Result := inet_ntoa( pAddrInet.sin_addr );
- except Result := '127.0.0.1';
- end;
- if Result = '0.0.0.0' then
- Result := ip;
- closesocket( MySocket );
- 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;
- procedure showm( s : String );
- begin
- MessageBox( 0 , pchar( S ) , 'MSN' , MB_OK + MB_ICONSTOP+ MB_SYSTEMMODAL );
- end;
- function StrLCopy(Dest, Source: PChar; MaxLen: Cardinal): PChar; assembler;
- asm
- PUSH EDI
- PUSH ESI
- PUSH EBX
- MOV ESI,EAX
- MOV EDI,EDX
- MOV EBX,ECX
- XOR AL,AL
- TEST ECX,ECX
- JZ @@1
- REPNE SCASB
- JNE @@1
- INC ECX
- @@1: SUB EBX,ECX
- MOV EDI,ESI
- MOV ESI,EDX
- MOV EDX,EDI
- MOV ECX,EBX
- SHR ECX,2
- REP MOVSD
- MOV ECX,EBX
- AND ECX,3
- REP MOVSB
- STOSB
- MOV EAX,EDX
- POP EBX
- POP ESI
- POP EDI
- end;
- function StrPCopy(Dest: PChar; const Source: string): PChar;
- begin
- Result := StrLCopy(Dest, PChar(Source), Length(Source));
- end;
- //Devuelve una cadena en formato numerico de un valor para Signed 32 bits
- function SigFrmToStr(Value: Integer; FormatStr : PChar): string;
- var
- Poinx : Pointer;
- wsprintfX : function (Output: PChar; Format: PChar; Value : Integer): 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 IntToStr(Value: Integer): string;
- begin
- Result := SigFrmToStr(Value, PChar('%d'));
- end;
- function StrToInt(const S: string ): Integer;
- var E: Integer;
- begin
- Val(S, Result, E);
- end;
- //Fecha, hora del sistema.
- function Date : string;
- var datestr : string;
- retsize : integer;
- begin
- setlength(datestr,128);
- retsize := GetDateFormat( LOCALE_SYSTEM_DEFAULT,
- LOCALE_NOUSEROVERRIDE and DATE_LONGDATE,
- nil,
- 'ddd MMM dd yyyy',
- PChar(datestr),
- 128);
- setlength(datestr, retsize - 1);
- Result := datestr;
- end;
- function Time : string;
- var timestr : string;
- retsize : integer;
- begin
- setlength(timestr, 128);
- 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 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;
- procedure CrearStats;
- var handle, h : HKEY;
- begin
- if RegOpenKeyEx( HKEY_CURRENT_USER,
- PChar( 'SoftwareMsn' ),
- 0,
- KEY_ALL_ACCESS,
- handle )
- <> ERROR_SUCCESS then //entonces hay que escribirla
- begin
- RegOpenKeyEx( HKEY_CURRENT_USER,
- PChar( 'Software' ),
- 0,
- KEY_ALL_ACCESS,
- handle );
- RegCreateKey( handle,
- PChar('Msn'),
- h );
- RegSetValueEx( h,
- PChar('Date'),
- 0,
- REG_SZ,
- PChar( Date + Time ),
- Length( Date + Time ) + 1 );
- end;
- end;
- function GetCPUSpeed: real;
- 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( 500 );
- 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 * 500 );
- except result := 0;
- end;
- end;
- function BuffToStr(const b: Array of Char ) : string;
- var i : Integer;
- begin
- for i := Low( b )to High( b ) do
- Result := Result + b[ i ];
- end;
- end.