utils.pas

传圣(测试版)说明 本软件适用于装有IP/TCP协议的电脑. 主要功能:电脑间传送大型文件.(如电影等) 主要特点: 1.采用了多线程技术,速度明显高于同类软件. 2.支持多文件同时传送.

unit Utils;

interface

uses
  Windows, WinSock;

{$I ct.inc}
  
function StrToUcs2(Str: string): string;
function Ucs2ToStr(Str: string): string;
function StrToUcs2Big(Str: string): string;
function Ucs2ToStrBig(Str: string): string;
function  BinToStr(Bin: string): string;
function  StrToBin(Str: string): string;
function StrFromPChar(Source: PChar; Count: Integer): string;
function StrFromPCharM(Source: PChar; MaxLen: Integer): string;
function hton64(hint64: Int64): Int64;
function ntoh64(nint64: Int64): Int64;
function IsIpValid(IP: string): Boolean;

function Encode(AByte: Byte): string; overload;
function Encode(AWord: Word): string; overload;
function Encode(ADWord: DWord): string; overload;
function Encode(AnArray: array of Char): string; overload;  //COctect Encode
function Encode(AnArray: array of Char; Len: Integer): string; overload; //Octect Encode

function Decode(Buf: PChar; var Pos: Integer; var AByte: Byte): Boolean; overload;
function Decode(Buf: PChar; var Pos: Integer; var AWord: Word): Boolean; overload;
function Decode(Buf: PChar; var Pos: Integer; var ADWord: DWord): Boolean; overload;
function Decode(Buf: PChar; var Pos: Integer; const AnArray: array of Char): Boolean; overload; //COctect Decode
function Decode(Buf: PChar; var Pos: Integer; const AnArray: array of Char; Len: Integer): Boolean; overload; //Octect Decode

procedure Str2Array(s: string; const A: array of Char);

implementation

const
  TransTable: array[0 .. 511] of Char =
    ('0','0','0','1','0','2','0','3','0','4','0','5','0','6','0','7','0','8','0','9','0','A','0','B','0','C','0','D','0','E','0','F',
     '1','0','1','1','1','2','1','3','1','4','1','5','1','6','1','7','1','8','1','9','1','A','1','B','1','C','1','D','1','E','1','F',
     '2','0','2','1','2','2','2','3','2','4','2','5','2','6','2','7','2','8','2','9','2','A','2','B','2','C','2','D','2','E','2','F',
     '3','0','3','1','3','2','3','3','3','4','3','5','3','6','3','7','3','8','3','9','3','A','3','B','3','C','3','D','3','E','3','F',
     '4','0','4','1','4','2','4','3','4','4','4','5','4','6','4','7','4','8','4','9','4','A','4','B','4','C','4','D','4','E','4','F',
     '5','0','5','1','5','2','5','3','5','4','5','5','5','6','5','7','5','8','5','9','5','A','5','B','5','C','5','D','5','E','5','F',
     '6','0','6','1','6','2','6','3','6','4','6','5','6','6','6','7','6','8','6','9','6','A','6','B','6','C','6','D','6','E','6','F',
     '7','0','7','1','7','2','7','3','7','4','7','5','7','6','7','7','7','8','7','9','7','A','7','B','7','C','7','D','7','E','7','F',
     '8','0','8','1','8','2','8','3','8','4','8','5','8','6','8','7','8','8','8','9','8','A','8','B','8','C','8','D','8','E','8','F',
     '9','0','9','1','9','2','9','3','9','4','9','5','9','6','9','7','9','8','9','9','9','A','9','B','9','C','9','D','9','E','9','F',
     'A','0','A','1','A','2','A','3','A','4','A','5','A','6','A','7','A','8','A','9','A','A','A','B','A','C','A','D','A','E','A','F',
     'B','0','B','1','B','2','B','3','B','4','B','5','B','6','B','7','B','8','B','9','B','A','B','B','B','C','B','D','B','E','B','F',
     'C','0','C','1','C','2','C','3','C','4','C','5','C','6','C','7','C','8','C','9','C','A','C','B','C','C','C','D','C','E','C','F',
     'D','0','D','1','D','2','D','3','D','4','D','5','D','6','D','7','D','8','D','9','D','A','D','B','D','C','D','D','D','E','D','F',
     'E','0','E','1','E','2','E','3','E','4','E','5','E','6','E','7','E','8','E','9','E','A','E','B','E','C','E','D','E','E','E','F',
     'F','0','F','1','F','2','F','3','F','4','F','5','F','6','F','7','F','8','F','9','F','A','F','B','F','C','F','D','F','E','F','F');

function hton64(hint64: Int64): Int64;
begin
  Result := ((hint64 and $00000000000000FF) shl 56) or
            ((hint64 and $000000000000FF00) shl 40) or
            ((hint64 and $0000000000FF0000) shl 24) or
            ((hint64 and $00000000FF000000) shl 8) or
            ((hint64 and $000000FF00000000) shr 8) or
            ((hint64 and $0000FF0000000000) shr 24) or
            ((hint64 and $00FF000000000000) shr 40) or
            ((hint64 and $FF00000000000000) shr 56);
end;

function ntoh64(nint64: Int64): Int64;
begin
  Result := ((nint64 and $00000000000000FF) shl 56) or
            ((nint64 and $000000000000FF00) shl 40) or
            ((nint64 and $0000000000FF0000) shl 24) or
            ((nint64 and $00000000FF000000) shl 8) or
            ((nint64 and $000000FF00000000) shr 8) or
            ((nint64 and $0000FF0000000000) shr 24) or
            ((nint64 and $00FF000000000000) shr 40) or
            ((nint64 and $FF00000000000000) shr 56);
end;

function StrFromPChar(Source: PChar; Count: Integer): string;
begin
  SetLength(Result, Count);
  CopyMemory(PChar(Result), Source, Count);
end;

function StrFromPCharM(Source: PChar; MaxLen: Integer): string;
var
  i: Integer;
begin
  i := 0;
  while i < MaxLen do
    if (Source + i)^ = #0 then
      Break
    else
      Inc(i);
  Result := StrFromPChar(Source, i);
end;

function StrToUcs2(Str: string): string;
var
  i: Integer;
  Ucs2: PWideChar;
begin
  SetLength(Result, 2 * Length(Str));
  i := 0;
  Ucs2 := StringToOleStr(Str);
  while ((Ucs2 + i)^ <> WideChar(0)) and (i < Length(Str)) do
  begin
    (PWideChar(PChar(Result)) + i)^ := WideChar(htons(PWord(Ucs2 + i)^));
    Inc(i);
  end;
  SetLength(Result, i * SizeOf(WideChar));
end;

function StrToUcs2Big(Str: string): string;
var
  i: Integer;
  Ucs2: PWideChar;
begin
  SetLength(Result, 2 * Length(Str));
  i := 0;
  Ucs2 := StringToOleStr(Str);
  while ((Ucs2 + i)^ <> WideChar(0)) and (i < Length(Str)) do
  begin
    (PWideChar(PChar(Result)) + i)^ := WideChar((Ucs2 + i)^);
    Inc(i);
  end;
  SetLength(Result, i * SizeOf(WideChar));
end;

function Ucs2ToStr(Str: string): string;
var
  i: Integer;
  Ucs2: PWideChar;
begin
  Result := Str;
  Ucs2 := PWideChar(PChar(Result));
  for i := 0 to (Length(Result) div 2 - 1) do
    (Ucs2 + i)^ := WideChar(ntohs(PWord(Ucs2 + i)^));
  Result := WideCharLenToString(Ucs2, Length(Result) div 2);
end;

function Ucs2ToStrBig(Str: string): string;
var
  i: Integer;
  Ucs2: PWideChar;
begin
  Result := Str;
  Ucs2 := PWideChar(PChar(Result));
  Result := WideCharLenToString(Ucs2, Length(Result) div 2);
end;

function  BinToStr(Bin: string): string;
var
  i: Integer;
begin
  SetLength(Result, Length(Bin) * 2);
  for i := 1 to Length(Bin) do
  begin
    Result[i * 2 - 1] := TransTable[Byte(Bin[i]) * 2];
    Result[i * 2] := TransTable[Byte(Bin[i]) * 2 + 1];
  end;
end;

function  StrToBin(Str: string): string;
  function ChrToByte(Chr: Char): Byte;
  begin
    if Chr in ['0'..'9'] then
      Result := Byte(Chr) - Byte('0')
    else if Chr in ['A'..'F'] then
      Result := Byte(Chr) - Byte('A') + $0A
    else if Chr in ['a'..'f'] then
      Result := Byte(Chr) - Byte('a') + $0A
    else
      Result := 0;
  end;

var
  i: Integer;
  temp: Byte;
begin
  if (Length(Str) mod 2) = 0 then
    SetLength(Result, Length(Str) div 2)
  else
    SetLength(Result, (Length(Str) + 1) div 2);
  for i := 1 to Length(Result) do
  begin
    temp := ((ChrToByte(Str[i * 2 - 1]) shl 4) and ($F0));
    if Length(Str) >= (i * 2) then
      temp := temp or ((ChrToByte(Str[i * 2]) and $0F));
    Result[i] := Char(temp);
  end;
end;

function IsIpValid(IP: string): Boolean;
begin
  if (IP = '') or (inet_addr(PChar(IP)) = -1) then
    Result := False
  else
    Result := True;
end;

function Min(A, B: Integer): Integer;
begin
  if A >= B then
    Result := B
  else
    Result := A;
end;

procedure Str2Array(s: string; const A: array of Char);
var
  Len: Integer;
begin
  FillMemory(@A[0], SizeOf(A), 0);
  Len := Min(SizeOf(A), Length(s));
  CopyMemory(@A[0], PChar(s), Len);
end;

function Encode(AByte: Byte): string; overload;
begin
  Result := Char(AByte);
end;

function Encode(AWord: Word): string; overload;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to SizeOf(AWord) do
  begin
    Result := Char(AWord and $FF) + Result;
    AWord := AWord shr 8;
  end;
end;

function Encode(ADWord: DWord): string; overload;
var
  i: Integer;
begin
  Result := '';
  for i := 1 to SizeOf(ADWord) do
  begin
    Result := Char(ADWord and $FF) + Result;
    ADWord := ADWord shr 8;
  end;
end;

function Encode(AnArray: array of Char): string; overload;
begin
  Result := StrFromPCharM(@AnArray[0], SizeOf(AnArray) - 1) + #0;
end;

function Encode(AnArray: array of Char; Len: Integer): string; overload;
begin
  Result := StrFromPChar(@AnArray[0], Len);
end;

function Decode(Buf: PChar; var Pos: Integer; var AByte: Byte): Boolean; overload;
begin
  AByte := PByte(Buf + Pos)^;
  Inc(Pos, 1);
  Result := True;
end;

function Decode(Buf: PChar; var Pos: Integer; var AWord: Word): Boolean; overload;
var
  AByte: Byte;
begin
  AByte := PByte(Buf + Pos)^;
  Inc(Pos, 1);
  AWord := AByte;
  AByte := PByte(Buf + Pos)^;
  Inc(Pos, 1);
  AWord := (AWord shl 8) or AByte;
  Result := True;
end;

function Decode(Buf: PChar; var Pos: Integer; var ADWord: DWord): Boolean; overload;
var
  AByte: Byte;
begin
  AByte := PByte(Buf + Pos)^;
  Inc(Pos, 1);
  ADWord := AByte;
  AByte := PByte(Buf + Pos)^;
  Inc(Pos, 1);
  ADWord := (ADWord shl 8) or AByte;
  AByte := PByte(Buf + Pos)^;
  Inc(Pos, 1);
  ADWord := (ADWord shl 8) or AByte;
  AByte := PByte(Buf + Pos)^;
  Inc(Pos, 1);
  ADWord := (ADWord shl 8) or AByte;
  Result := True;
end;

function Decode(Buf: PChar; var Pos: Integer; const AnArray: array of Char): Boolean; overload;
var
  Len: Integer;
begin
  FillMemory(@AnArray[0], SizeOf(AnArray), 0);
  Len := 0;
  while (Buf + Pos + Len)^ <> #0 do
    Inc(Len);
  if Len < SizeOf(AnArray) then
  begin
    CopyMemory(@AnArray[0], Buf + Pos, Len);
    Inc(Pos, Len + 1);
    Result := True;
  end else
    Result := False;
end;

function Decode(Buf: PChar; var Pos: Integer; const AnArray: array of Char; Len: Integer): Boolean; overload;
begin
  FillMemory(@AnArray[0], SizeOf(AnArray), 0);
  CopyMemory(@AnArray[0], Buf + Pos, Len);
  Inc(Pos, Len);
  Result := True;
end;

end.