Име: Радослав
Група: Потребител
Ранг: Новопостъпил
Мнения: 1
Регистриран на: 27.06.11
|
Някой ще помогне ли да пренапишем този Delphi скрипт на PHP?! Ето кода  | CODE | unit uTCPCommon;
{Версия 3.0}
interface
uses Windows, scktcomp, Variants, SysUtils, DateUtils;
const
{!!!!!! *** ключовете са за XOR на стрингове ->
не трябва да се получава #0 - край на стринг *** !!!!!!}
Key : string[128] = 'A3v5%)g dgверСДГжфдСДФ4656dcfgfZ' +
#1#2#4#4#9#8#4#6#6#7#3#1#9#7#1#5 +
'FgАцЧшщшщ2ДaXdf,54w2Ass%6*9)*965' +
#3#5#4#6#9#8#4#9#6#7#5#1#9#3#2#4 +
'Dfс#дф#дг##@д2 Д3СДSd$$FVFseDF34';
{не трябва да съдържа цифри, букви, интервали, запетаи...!!!}
MaxPacketSize = 1024;
PacketHeaderSize = 8; {да е кратно на 8 (полетата в recodr-а в Delphi се разполагат на кратни ардеси)}
{RPacketHeader - index in array}
I_PacketKind = 1;
I_ID_Req = 2;
I_ID_Packet = 3;
I_CSum = 4;
I_DataLen_Lo = 5;
I_DataLen_Hi = 6;
I_Reserved1 = 7;
I_Reserved2 = 8;
MaxDataLen = MaxPacketsize - PacketHeaderSize; {с хедъра да е до 1024}
CheckAckTime = 30; {време между 2 проверки за получено потвърждение}
CheckAckNum = 12; {брой неуспешни проверки за потвърждение, след които препредава}
{ време преди препредаване(ms) = CheckAckTime * CheckAckNum}
{!!! за сървъра TimeOut-а да е различен от този на клиента - }
{ може да се получи наслагване на пакетите за потвърждение и първи пакет с данни !!!}
SrvCheckAckTime = 15; {време между 2 проверки за получено потвърждение}
SrvCheckAckNum = 20; {брой неуспешни проверки за потвърждение, след които препредава}
{ време преди препредаване(ms) = CheckAckTime * CheckAckNum}
MaxRetryNum = 60; {максимален брой опити за препредаване на пакет}
{ време преди отказ от предаване(ms) = MaxRetryNum * CheckAckNum * CheckAckTime}
FieldSeparator = #30; {разделител на полета}
type
PPacket = ^RPacket;
RPacketHeader = array [1..PacketHeaderSize] of byte;
RPacketData = array [1..MaxDataLen] of byte;
RPacket = record
Header : RPacketHeader;
Data : RPacketData;
end; {RPacket}
function CalcCSum (const Pckt : RPacket) : byte;
function ReceivePacket (Socket: TCustomWinSocket;
var Pckt : RPacket) : boolean;
function SendPacket (Socket: TCustomWinSocket;
var Pckt : RPacket) : boolean;
function EncryptPacket (const S : string; var Pckt : RPacket) : boolean;
function DecryptPacket (const Pckt : RPacket; var S : string) : boolean;
function GetVar (const S : string; const VarType : char; var sp : integer; var ErrFlag : boolean) : variant;
implementation
function CalcCSum (const Pckt : RPacket) : byte;
var
i : integer;
begin
Result := Pckt.Header[I_PacketKind] xor
Pckt.Header[I_ID_Req] xor
Pckt.Header[I_ID_Packet] xor
Pckt.Header[I_DataLen_Lo] xor
Pckt.Header[I_DataLen_Hi] xor
Pckt.Header[I_Reserved1] xor
Pckt.Header[I_Reserved2];
for i := (Pckt.Header[I_DataLen_Lo] +
(256*Pckt.Header[I_DataLen_Hi])) downto 1 do
begin
Result := Result xor Pckt.Data[i];
end;
end; {CalcCSum}
function SendPacket (Socket: TCustomWinSocket;
var Pckt : RPacket) : boolean;
var
PcktSize : integer; {размер на пакета - данни + служебни}
i : integer;
SendSize : integer;
begin
Pckt.Header[I_CSum] := CalcCSum (Pckt);
PcktSize := PacketHeaderSize + (Pckt.Header[I_DataLen_Lo] +
(256*Pckt.Header[I_DataLen_Hi]));
i := 10;
repeat
SendSize := Socket.SendBuf (Pckt, PcktSize);
Result := (SendSize = PcktSize);
if not Result then
begin
Sleep (0);
Sleep (100);
dec (i);
end;
until (Result) or (i <= 0);
end; {SendPacket}
function ReceivePacket (Socket: TCustomWinSocket;
var Pckt : RPacket) : boolean;
var
PcktSize : integer; {размер на пакета - данни + служебни}
begin
Result := false;
PcktSize := Socket.ReceiveBuf (Pckt, SizeOf (Pckt));
if PcktSize >= PacketHeaderSize then
begin
if (Chr(Pckt.Header[I_PacketKind]) >= '0') and
(Chr(Pckt.Header[I_PacketKind]) <= '2') and
( (Pckt.Header[I_DataLen_Lo] +
(256*Pckt.Header[I_DataLen_Hi])) = (PcktSize - PacketHeaderSize)) then
begin
if Pckt.Header[I_CSum] = CalcCSum (Pckt) then
Result := true;
end;
end; {if PcktSize >= PacketHeaderSize then ...}
end; {ReceivePacket}
function EncryptPacket (const S : string; var Pckt : RPacket) : boolean;
var
i : integer;
begin
if Length (s) > MaxDataLen then
Result := false
else
begin
Pckt.Header[I_DataLen_Lo] := (Length(s)) mod 256;
Pckt.Header[I_DataLen_Hi] := (Length(s)) div 256;
for i := Length (s)downto 1 do
Pckt.Data[i] := Ord(S[i]) xor Ord(Key[i mod Length(Key) + 1]);
Result := true;
end;
end; {EncryptString}
function DecryptPacket (const Pckt : RPacket; var S : string) : boolean;
var
i : integer;
begin
SetLength (s, Pckt.Header[I_DataLen_Lo] + (256*Pckt.Header[I_DataLen_Hi]));
for i := Length (s) downto 1 do
s[i] := Chr ( Pckt.Data[i] xor Ord(Key[i mod Length(Key) + 1]));
Result := true;
end; {DecryptString}
function EncryptRegString (const S : string) : string;
var
i : integer;
begin
SetLength (Result, Length(s));
for i := 1 to Length (s) do
Result[i] := Chr ( Ord(S[i]) xor Ord(Key[i mod Length(RegKey) + 1]));
end; {EncryptRegString}
function DecryptRegString (const S : string) : string;
var
i : integer;
begin
SetLength (Result, Length(s));
for i := 1 to Length (s) do
Result[i] := Chr ( Ord(S[i]) xor Ord(Key[i mod Length(RegKey) + 1]));
end; {DecryptRegString}
function GetVar (const S : string; const VarType : char; var sp : integer; var ErrFlag : boolean) : variant;
var
VStr : string;
l : integer;
yy,mm,dd,hh,nn,ss,www : word; {за обработка на datetime}
begin
Result := null;
ErrFlag := false;
if sp > Length (S) then
begin
ErrFlag := true;
end;
l := 0;
while ( (s[sp+l]) <> FieldSeparator) and
((sp+l) < length(S) ) do
inc (l);
if (s[sp+l] <> FieldSeparator) then
begin
ErrFlag := true;
end;
try
if l = 0 then
Result := null
else
begin
VStr := Copy(s, sp, l);
Case VarType of
'S' : Result := VStr;
'I' : Result := StrToInt(VStr);
'F' : Result := StrToFloat(VStr);
'L' : if Trim(VStr) = '1' then
Result := true
else
Result := false;
'D' : begin
yy := StrToInt (Copy(VStr,1,4));
mm := StrToInt (Copy(VStr,5,2));
dd := StrToInt (Copy(VStr,7,2));
hh := StrToInt (Copy(VStr,10,2));
nn := StrToInt (Copy(VStr,13,2));
ss := StrToInt (Copy(VStr,16,2));
www := StrToInt (Copy(VStr,19,3));
Result := EncodeDateTime( yy,mm,dd,hh,nn,ss,www);
end;
end; {Case VarType of ...}
end; {if l = 0 then ... else ...}
except
ErrFlag := true;
end;
sp := sp + l + 1;
end; {GetVar}
end. |
|
от Delphi пренаписване на PHP
Помощ 
Търсене 
Потребители 
Календар 
Правила
