l3m0n
asked on
[Delphi XE] Type instead of string.
hi i try to use component from delphi 7 in delphi xe and i have problems.
( my component is for connecting to one comunicator like msn in poland (gg))
My code is working in delphi 7 but in xe it didnt.
Firstly i cant connect to the server. When i changed ServerHost variable type from String to AnsiString it works, but when i try to change it in all places like in "discription" variable it fails.
Please help me what type of variable i can use in delphi xe instead of string.
( my component is for connecting to one comunicator like msn in poland (gg))
My code is working in delphi 7 but in xe it didnt.
Firstly i cant connect to the server. When i changed ServerHost variable type from String to AnsiString it works, but when i try to change it in all places like in "discription" variable it fails.
Please help me what type of variable i can use in delphi xe instead of string.
Would you provide more details please? What is the datatype of the other variables:
PHeader
TGGNewStatus
FStatus
DOpis
ZWOpis
NDOpis
I see some pointers involved and hence you cast the AnsiString value to PAnsiChar, for instance, your last example can go like this:
Here is something to read about Unicode Migration:
http://www.embarcadero.com/images/dm/technical-papers/delphi-unicode-migration.pdf
PHeader
TGGNewStatus
FStatus
DOpis
ZWOpis
NDOpis
I see some pointers involved and hence you cast the AnsiString value to PAnsiChar, for instance, your last example can go like this:
if (FStatus=DOpis)or(FStatus=ZWOpis)or(FStatus=NWOpis)or(FStatus=NDOpis) then begin
send(sock,PAnsiChar(FOpis[1]),Length(FOpis)+1,0);
send(sock,Pointer(#0)^,SizeOf(#0),0);
end;Here is something to read about Unicode Migration:
http://www.embarcadero.com/images/dm/technical-papers/delphi-unicode-migration.pdf
ASKER
code:
unit GaduGadu;
interface
uses
SysUtils, Classes, WinSock, Windows;
type
{Pakiety}
TGGHeader = record
_type:LongInt;
_length:LongInt;
end;
PGGHeader = ^TGGHeader;
TGGWelcome = record
_seed:LongInt;
end;
PGGWelcome = ^TGGWelcome;
TGGLogin = record
_uin: LongInt;
_hash: LongInt;
_status: LongInt;
_version: LongInt;
_unknown1: byte;
_local_ip: LongInt;
_local_port: LongInt;
_ext_ip: LongInt;
_image_size: byte;
_unknown2: byte;
end;
PGGLogin = ^TGGLogin;
TGGSendMsg = record
_recipient: LongInt;
_seq: LongInt;
_class: LongInt;
end;
PGGSendMsg = ^TGGSendMsg;
TGGMsgRichtext = record
_flag: byte;
_length: short;
end;
PGGMsgRichtext = ^TGGMsgRichtext;
TGGMsgRichtextFormat = record
_position: short;
_font: byte;
end;
PGGMsgRichtextFormat = ^TGGMsgRichTextFormat;
TGGRecvMsg = record
_sender: LongInt;
_seq: LongInt;
_time: LongInt;
_class: LongInt;
end;
PGGRecvMsg = ^TGGRecvMsg;
TGGNewStatus = record
_status: LongInt;
end;
PGGNewStatus = ^TGGNewStatus;
{Wlasne typy zmiennych}
TStatus = (D, DOpis,
ZW, ZWOpis,
NW, NWOpis,
ND, NDOpis);
{Zdarzenia}
TOnMessageEvent = procedure(Sender: TObject; MsgFrom:Integer; Wiadomosc:AnsiString) of object;
TGaduGadu = class(TComponent)
private
WSA:WSAData;
Sock:TSocket;
SockInfo:sockaddr_in;
FConnected:Boolean;
FLogin:LongInt;
FPassword:AnsiString;
FServerIP:AnsiString;
FServerPort:Integer;
FOnConnected:TNotifyEvent;
FOnMessage:TOnMessageEvent;
FOnDisconnect:TNotifyEvent;
FStatus:TStatus;
FOpis:AnsiString;
Timer:TThread;
RecvTh: TThread;
function StatusToInt(S:TStatus):LongInt;
function GGLH(Pass:AnsiString;key:LongInt):LongInt;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ConnectEx:Boolean;
function Wyslij(Adresat:Integer;Wiadomosc:AnsiString):Boolean;
function UstawStatus:Boolean;
function Disconnect:Boolean;
published
property Login:LongInt read FLogin write FLogin;
property Haslo:AnsiString read FPassword write FPassword;
property SerwerIP:AnsiString read FServerIP write FServerIP;
property SerwerPort:Integer read FServerPort write FServerPort;
property Polaczenie:Boolean read FConnected;
property OnConnected:TNotifyEvent read FOnConnected write FOnConnected;
property Status:TStatus read FStatus write FStatus;
property OnMessage:TOnMessageEvent read FOnMessage write FOnMessage;
property OnDisconnected:TNotifyEvent read FOnDisconnect write FOnDisconnect;
property Opis:AnsiString read FOpis write FOpis;
end;
{PING/PONG}
TTimer = class(TThread)
private
GG:TGaduGadu;
protected
constructor Create(GGX: TGaduGadu);
procedure Execute; override;
end;
{ODPOWIEDZI SERWERA}
TRecvThread = class(TThread)
private
GG:TGaduGadu;
protected
constructor Create(GGX: TGaduGadu);
procedure Execute; override;
end;
procedure Register;
implementation
procedure TTimer.Execute;
var
PHeader:TGGHeader;
begin
PHeader._type:=$8;
PHeader._length:=0;
repeat
Sleep(60000);
if GG.FConnected then begin
send(GG.Sock,PHeader,sizeof(TGGHeader),0);
end;
until(false);
end;
constructor TRecvThread.Create(GGX:TGaduGadu);
begin
GG:=GGX;
inherited Create(true);
end;
constructor TTimer.Create(GGX:TGaduGadu);
begin
GG:=GGX;
inherited Create(true);
end;
procedure TRecvThread.Execute;
var
PPacket:Pointer;
RecvHeader: TGGHeader;
RecvMsg: PGGRecvMsg;
NullAnsiString:AnsiString;
NullChar:Char;
Size:Integer;
begin
repeat
Size:=recv(GG.Sock,RecvHeader,SizeOf(RecvHeader),0);
if Size < 1 then Break;
if GG.FConnected then begin
case RecvHeader._type of
$a: begin
GetMem(PPacket,SizeOf(TGGRecvMsg));
RecvMsg := PGGRecvMsg(PPacket);
recv(GG.Sock, RecvMsg^,SizeOf(TGGRecvMsg),0);
NullAnsiString:='';
repeat
recv(GG.Sock,NullChar,SizeOf(NullChar),0);
if NullChar<>#0 then NullAnsiString:=NullAnsiString+NullChar;
until NullChar=#0;
If Assigned(GG.FOnMessage) then
GG.FOnMessage(Self, RecvMsg^._sender, NullAnsiString);
end;
end;
end;
until(false);
GG.FConnected:=False;
if Assigned(GG.FOnDisconnect) then
GG.FOnDisconnect(Self);
end;
procedure Register;
begin
RegisterComponents('Inne', [TGaduGadu]);
end;
constructor TGaduGadu.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FConnected:=False;
WSAStartup(MakeWord(2,0),WSA);
Timer:=TTimer.Create(Self);
Timer.FreeOnTerminate:=false;
RecvTh:=TRecvThread.Create(Self);
RecvTh.FreeOnTerminate:=false;
end;
destructor TGaduGadu.Destroy;
begin
if FConnected then
send(Sock, Pointer($b)^, SizeOf($b), 0);
closesocket(Sock);
WSACleanUp;
Timer.Free;
RecvTh.Free;
end;
function TGaduGadu.StatusToInt(S:TStatus):LongInt;
begin
Result:=0;
case S of
D: Result:=$2;
DOpis: Result:=$4;
ZW: Result:=$3;
ZWOpis: Result:=$5;
NW: Result:=$14;
NWOpis: Result:=$16;
ND: Result:=$1;
NDOpis: Result:=$15;
end;
end;
function TGaduGadu.GGLH(Pass:AnsiString;key:LongInt):LongInt;
var
x, y, z, i :Integer;
begin
y := key;
x := 0;
for i := 1 to length(haslo) do
begin
x := (x and $ffffff00) or ord(haslo[i]);
y := y xor x;
y := y + x;
x := x shl 8;
y := y xor x;
x := x shl 8;
y := y - x;
x := x shl 8;
y := y xor x;
z := y and $1F;
y := (y shl z ) or (y shr (32-z));
end;
Result:=y;
end;
function TGaduGadu.ConnectEx:Boolean;
var
hash:LongInt;
PHeader:PGGHeader;
PWelcome:PGGWelcome;
PLogin:PGGLogin;
PPacket:Pointer;
begin
Result:=False;
if not FConnected then begin
Sock := Socket(AF_INET, SOCK_STREAM,0);
SockInfo.sin_family:=AF_INET;
SockInfo.sin_addr.s_addr:=inet_addr(PAnsiChar(FServerIP));
SockInfo.sin_port:=htons(FServerPort);
if (connect(Sock,SockInfo,SizeOf(SockInfo))<>SOCKET_ERROR) then begin
GetMem(PPacket,sizeof(TGGHeader));
recv(Sock,PPacket^,sizeof(TGGHeader),0);
PHeader := PGGHeader(PPacket);
if (PHeader^._type = $1)and
(PHeader^._length = sizeof(TGGWelcome)) then begin
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGWelcome));
recv(Sock,PPacket^,sizeof(TGGWelcome),0);
PWelcome := PGGWelcome(PPacket);
hash:=PWelcome^._seed;
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$15;
PHeader^._length:=sizeof(TGGLogin);
send(Sock,PHeader^,sizeof(TGGHeader),0);
FreeMem(PHeader);
GetMem(PPacket,sizeof(TGGLogin));
PLogin := PGGLogin(PPacket);
PLogin^._uin:=FLogin;
PLogin^._hash:=GGLH(FPassword,hash);
PLogin^._status :=StatusToInt(FStatus);
PLogin^._version:=$21;
PLogin^._image_size:=255;
PLogin^._unknown2:= $be;
send(sock,PLogin^, sizeof(TGGLogin),0);
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGHeader));
recv(Sock,PPacket^,sizeof(TGGHeader),0);
PHeader:=PGGHeader(PPacket);
if PHeader^._type=$3 then begin
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$12;
PHeader^._length:=0;
send(Sock,PHeader^,sizeof(TGGHeader),0);
FreeMem(PPacket);
Result:=True;
FConnected:=True;
if Assigned(FOnConnected) then FOnConnected(Self);
Timer.Resume;
if Assigned(RecvTh) then begin
RecvTh.Terminate;
RecvTh.Free;
RecvTh:=Nil;
RecvTh:=TRecvThread.Create(Self);
end;
RecvTh.Resume;
end else if PHeader^._type=$9 then Result:=False;
end;
end;
end;
end;
function TGaduGadu.Wyslij(Adresat:Integer;Wiadomosc:AnsiString):Boolean;
var
PPacket:Pointer;
PSendMsg:PGGSendMsg;
PHeader:PGGHeader;
TextColor:array[0..2] of Byte;
X:array of AnsiString;
S:AnsiString;
I,Y:Integer;
begin
Result:=False;
if (FConnected) then begin
S:=Wiadomosc;
if Length(S)>1988 then begin
SetLength(X,1);
Y:=0;
repeat
SetLength(X,Y+1);
X[Y]:=Copy(S,1,1988);
Delete(S,1,1988);
Inc(Y);
until(Length(S)=0);
for I:=0 to Y-1 do begin
if ((FConnected)and(X[i]<>'')and(Adresat<>0)) then begin
if Length(X[i])>1988 then
X[i]:=Copy(X[i],1,1988);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$b;
TextColor[0]:=$0;
TextColor[1]:=$0;
TextColor[2]:=$0;
PHeader^._length:=SizeOf(TGGSendMsg)+
Length(X[i])+
SizeOf(#0);
send(Sock,PHeader^,sizeof(TGGHeader),0);
GetMem(PPacket,sizeof(TGGSendMsg));
PSendMsg := PGGSendMsg(PPacket);
PSendMsg^._seq:=0;
PSendMsg^._recipient:=Adresat;
PSendMsg^._class:=$4;
send(Sock,PSendMsg^, sizeof(TGGSendMsg),0);
send(Sock,X[i][1],length(X[i])+1,0);
send(Sock,Pointer(#0)^,sizeof(#0),0);
end;
end;
end else begin
if ((FConnected)and(Wiadomosc<>'')and(Adresat<>0)) then begin
if Length(Wiadomosc)>1988 then
Wiadomosc:=Copy(Wiadomosc,1,1988);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$b;
TextColor[0]:=$0;
TextColor[1]:=$0;
TextColor[2]:=$0;
PHeader^._length:=SizeOf(TGGSendMsg)+
Length(Wiadomosc)+
SizeOf(#0);
send(Sock,PHeader^,sizeof(TGGHeader),0);
GetMem(PPacket,sizeof(TGGSendMsg));
PSendMsg := PGGSendMsg(PPacket);
PSendMsg^._seq:=0;
PSendMsg^._recipient:=Adresat;
PSendMsg^._class:=$4;
send(Sock,PSendMsg^, sizeof(TGGSendMsg),0);
send(Sock,Wiadomosc[1],length(Wiadomosc)+1,0);
send(Sock,Pointer(#0)^,sizeof(#0),0);
end;
end;
end;
end;
function TGaduGadu.UstawStatus:Boolean;
var
PPacket:Pointer;
PHeader:PGGHeader;
PNewStatus:PGGNewStatus;
begin
Result:=False;
if FConnected then begin
GetMem(PPacket,sizeof(TGGHeader));
PHeader:=PGGHeader(PPacket);
PHeader^._type:=$2;
if (FStatus=DOpis)or(FStatus=ZWOpis)or(FStatus=NWOpis)or(FStatus=NDOpis) then
PHeader^._length:=SizeOf(TGGNewStatus)+
Length(FOpis)+SizeOf(#0)
else
PHeader^._length:=SizeOf(TGGNewStatus);
send(Sock,PHeader^,sizeof(TGGHeader),0);
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGNewStatus));
PNewStatus:=PGGNewStatus(PPacket);
PNewStatus^._status:=StatusToInt(FStatus);
send(sock,PNewStatus^, SizeOf(TGGNewStatus),0);
if (FStatus=DOpis)or(FStatus=ZWOpis)or(FStatus=NWOpis)or(FStatus=NDOpis) then begin
send(sock,FOpis[1],Length(FOpis)+1,0);
send(sock,Pointer(#0)^,SizeOf(#0),0);
end;
Result:=True;
end;
end;
function TGaduGadu.Disconnect:Boolean;
begin
Result:=False;
if FConnected then begin
CloseSocket(Sock);
if Assigned(FOnDisconnect) then
FOnDisconnect(Self);
FConnected:=False;
Result:=True;
end;
end;
end.
At line 169, instead of:
NullChar:Char;
I changed to:
NullChar:AnsiChar;
And after that it compiles OK and Run OK. Are you getting errors? If yes which lines?
NullChar:Char;
I changed to:
NullChar:AnsiChar;
And after that it compiles OK and Run OK. Are you getting errors? If yes which lines?
ASKER
i said then i dont get errors. I can connect to the server but i cant change Discription (in polish: opis).
When i changed:
NullChar:Char;
to
NullChar:AnsiChar;
OnMessage is working :D thanks
i cant change this discription now too.
When i changed:
NullChar:Char;
to
NullChar:AnsiChar;
OnMessage is working :D thanks
i cant change this discription now too.
ASKER
and i cant send messages too :/ i dont undestand this
Can you show sample of the code you use please?
Try this
unit GaduGadu;
interface
uses
SysUtils, Classes, WinSock, Windows;
type
{Pakiety}
TGGHeader = record
_type:LongInt;
_length:LongInt;
end;
PGGHeader = ^TGGHeader;
TGGWelcome = record
_seed:LongInt;
end;
PGGWelcome = ^TGGWelcome;
TGGLogin = record
_uin: LongInt;
_hash: LongInt;
_status: LongInt;
_version: LongInt;
_unknown1: byte;
_local_ip: LongInt;
_local_port: LongInt;
_ext_ip: LongInt;
_image_size: byte;
_unknown2: byte;
end;
PGGLogin = ^TGGLogin;
TGGSendMsg = record
_recipient: LongInt;
_seq: LongInt;
_class: LongInt;
end;
PGGSendMsg = ^TGGSendMsg;
TGGMsgRichtext = record
_flag: byte;
_length: short;
end;
PGGMsgRichtext = ^TGGMsgRichtext;
TGGMsgRichtextFormat = record
_position: short;
_font: byte;
end;
PGGMsgRichtextFormat = ^TGGMsgRichTextFormat;
TGGRecvMsg = record
_sender: LongInt;
_seq: LongInt;
_time: LongInt;
_class: LongInt;
end;
PGGRecvMsg = ^TGGRecvMsg;
TGGNewStatus = record
_status: LongInt;
end;
PGGNewStatus = ^TGGNewStatus;
{Wlasne typy zmiennych}
TStatus = (D, DOpis,
ZW, ZWOpis,
NW, NWOpis,
ND, NDOpis);
{Zdarzenia}
TOnMessageEvent = procedure(Sender: TObject; MsgFrom:Integer; Wiadomosc:AnsiString) of object;
TGaduGadu = class(TComponent)
private
WSA:WSAData;
Sock:TSocket;
SockInfo:sockaddr_in;
FConnected:Boolean;
FLogin:LongInt;
FPassword:AnsiString;
FServerIP:AnsiString;
FServerPort:Integer;
FOnConnected:TNotifyEvent;
FOnMessage:TOnMessageEvent;
FOnDisconnect:TNotifyEvent;
FStatus:TStatus;
FOpis:AnsiString;
Timer:TThread;
RecvTh: TThread;
function StatusToInt(S:TStatus):LongInt;
function GGLH(Pass:AnsiString;key:LongInt):LongInt;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ConnectEx:Boolean;
function Wyslij(Adresat:Integer;Wiadomosc:AnsiString):Boolean;
function UstawStatus:Boolean;
function Disconnect:Boolean;
published
property Login:LongInt read FLogin write FLogin;
property Haslo:AnsiString read FPassword write FPassword;
property SerwerIP:AnsiString read FServerIP write FServerIP;
property SerwerPort:Integer read FServerPort write FServerPort;
property Polaczenie:Boolean read FConnected;
property OnConnected:TNotifyEvent read FOnConnected write FOnConnected;
property Status:TStatus read FStatus write FStatus;
property OnMessage:TOnMessageEvent read FOnMessage write FOnMessage;
property OnDisconnected:TNotifyEvent read FOnDisconnect write FOnDisconnect;
property Opis:AnsiString read FOpis write FOpis;
end;
{PING/PONG}
TTimer = class(TThread)
private
GG:TGaduGadu;
protected
constructor Create(GGX: TGaduGadu);
procedure Execute; override;
end;
{ODPOWIEDZI SERWERA}
TRecvThread = class(TThread)
private
GG:TGaduGadu;
protected
constructor Create(GGX: TGaduGadu);
procedure Execute; override;
end;
procedure Register;
implementation
procedure TTimer.Execute;
var
PHeader:TGGHeader;
begin
PHeader._type:=$8;
PHeader._length:=0;
repeat
Sleep(60000);
if GG.FConnected then begin
send(GG.Sock,PHeader,sizeof(TGGHeader),0);
end;
until(false);
end;
constructor TRecvThread.Create(GGX:TGaduGadu);
begin
GG:=GGX;
inherited Create(true);
end;
constructor TTimer.Create(GGX:TGaduGadu);
begin
GG:=GGX;
inherited Create(true);
end;
procedure TRecvThread.Execute;
var
PPacket:Pointer;
RecvHeader: TGGHeader;
RecvMsg: PGGRecvMsg;
NullAnsiString:AnsiString;
NullChar:AnsiChar;
Size:Integer;
begin
repeat
Size:=recv(GG.Sock,RecvHeader,SizeOf(RecvHeader),0);
if Size < 1 then Break;
if GG.FConnected then begin
case RecvHeader._type of
$a: begin
GetMem(PPacket,SizeOf(TGGRecvMsg));
RecvMsg := PGGRecvMsg(PPacket);
recv(GG.Sock, RecvMsg^,SizeOf(TGGRecvMsg),0);
NullAnsiString:='';
repeat
recv(GG.Sock,NullChar,SizeOf(NullChar),0);
if NullChar<>#0 then NullAnsiString:=NullAnsiString+NullChar;
until NullChar=#0;
If Assigned(GG.FOnMessage) then
GG.FOnMessage(Self, RecvMsg^._sender, NullAnsiString);
end;
end;
end;
until(false);
GG.FConnected:=False;
if Assigned(GG.FOnDisconnect) then
GG.FOnDisconnect(Self);
end;
procedure Register;
begin
RegisterComponents('Inne', [TGaduGadu]);
end;
constructor TGaduGadu.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FConnected:=False;
WSAStartup(MakeWord(2,0),WSA);
Timer:=TTimer.Create(Self);
Timer.FreeOnTerminate:=false;
RecvTh:=TRecvThread.Create(Self);
RecvTh.FreeOnTerminate:=false;
end;
destructor TGaduGadu.Destroy;
begin
if FConnected then
send(Sock, Pointer($b)^, SizeOf($b), 0);
closesocket(Sock);
WSACleanUp;
Timer.Free;
RecvTh.Free;
end;
function TGaduGadu.StatusToInt(S:TStatus):LongInt;
begin
Result:=0;
case S of
D: Result:=$2;
DOpis: Result:=$4;
ZW: Result:=$3;
ZWOpis: Result:=$5;
NW: Result:=$14;
NWOpis: Result:=$16;
ND: Result:=$1;
NDOpis: Result:=$15;
end;
end;
function TGaduGadu.GGLH(Pass:AnsiString;key:LongInt):LongInt;
var
x, y, z, i :Integer;
begin
y := key;
x := 0;
for i := 1 to length(haslo) do
begin
x := (x and $ffffff00) or ord(haslo[i]);
y := y xor x;
y := y + x;
x := x shl 8;
y := y xor x;
x := x shl 8;
y := y - x;
x := x shl 8;
y := y xor x;
z := y and $1F;
y := (y shl z ) or (y shr (32-z));
end;
Result:=y;
end;
function TGaduGadu.ConnectEx:Boolean;
var
hash:LongInt;
PHeader:PGGHeader;
PWelcome:PGGWelcome;
PLogin:PGGLogin;
PPacket:Pointer;
begin
Result:=False;
if not FConnected then begin
Sock := Socket(AF_INET, SOCK_STREAM,0);
SockInfo.sin_family:=AF_INET;
SockInfo.sin_addr.s_addr:=inet_addr(PAnsiChar(FServerIP));
SockInfo.sin_port:=htons(FServerPort);
if (connect(Sock,SockInfo,SizeOf(SockInfo))<>SOCKET_ERROR) then begin
GetMem(PPacket,sizeof(TGGHeader));
recv(Sock,PPacket^,sizeof(TGGHeader),0);
PHeader := PGGHeader(PPacket);
if (PHeader^._type = $1)and
(PHeader^._length = sizeof(TGGWelcome)) then begin
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGWelcome));
recv(Sock,PPacket^,sizeof(TGGWelcome),0);
PWelcome := PGGWelcome(PPacket);
hash:=PWelcome^._seed;
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$15;
PHeader^._length:=sizeof(TGGLogin);
send(Sock,PHeader^,sizeof(TGGHeader),0);
FreeMem(PHeader);
GetMem(PPacket,sizeof(TGGLogin));
PLogin := PGGLogin(PPacket);
PLogin^._uin:=FLogin;
PLogin^._hash:=GGLH(FPassword,hash);
PLogin^._status :=StatusToInt(FStatus);
PLogin^._version:=$21;
PLogin^._image_size:=255;
PLogin^._unknown2:= $be;
send(sock,PLogin^, sizeof(TGGLogin),0);
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGHeader));
recv(Sock,PPacket^,sizeof(TGGHeader),0);
PHeader:=PGGHeader(PPacket);
if PHeader^._type=$3 then begin
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$12;
PHeader^._length:=0;
send(Sock,PHeader^,sizeof(TGGHeader),0);
FreeMem(PPacket);
Result:=True;
FConnected:=True;
if Assigned(FOnConnected) then FOnConnected(Self);
Timer.Start;
if Assigned(RecvTh) then begin
RecvTh.Terminate;
RecvTh.Free;
RecvTh:=Nil;
RecvTh:=TRecvThread.Create(Self);
end;
RecvTh.Start;
end else if PHeader^._type=$9 then Result:=False;
end;
end;
end;
end;
function TGaduGadu.Wyslij(Adresat:Integer;Wiadomosc:AnsiString):Boolean;
var
PPacket:Pointer;
PSendMsg:PGGSendMsg;
PHeader:PGGHeader;
TextColor:array[0..2] of Byte;
X:array of AnsiString;
S:AnsiString;
I,Y:Integer;
begin
Result:=False;
if (FConnected) then begin
S:=Wiadomosc;
if Length(S)>1988 then begin
SetLength(X,1);
Y:=0;
repeat
SetLength(X,Y+1);
X[Y]:=Copy(S,1,1988);
Delete(S,1,1988);
Inc(Y);
until(Length(S)=0);
for I:=0 to Y-1 do begin
if ((FConnected)and(X[i]<>'')and(Adresat<>0)) then begin
if Length(X[i])>1988 then
X[i]:=Copy(X[i],1,1988);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$b;
TextColor[0]:=$0;
TextColor[1]:=$0;
TextColor[2]:=$0;
PHeader^._length:=SizeOf(TGGSendMsg)+
Length(X[i])+
SizeOf(#0);
send(Sock,PHeader^,sizeof(TGGHeader),0);
GetMem(PPacket,sizeof(TGGSendMsg));
PSendMsg := PGGSendMsg(PPacket);
PSendMsg^._seq:=0;
PSendMsg^._recipient:=Adresat;
PSendMsg^._class:=$4;
send(Sock,PSendMsg^, sizeof(TGGSendMsg),0);
send(Sock,X[i][1],length(X[i])+1,0);
send(Sock,Pointer(#0)^,sizeof(#0),0);
end;
end;
end else begin
if ((FConnected)and(Wiadomosc<>'')and(Adresat<>0)) then begin
if Length(Wiadomosc)>1988 then
Wiadomosc:=Copy(Wiadomosc,1,1988);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$b;
TextColor[0]:=$0;
TextColor[1]:=$0;
TextColor[2]:=$0;
PHeader^._length:=SizeOf(TGGSendMsg)+
Length(Wiadomosc)+
SizeOf(#0);
send(Sock,PHeader^,sizeof(TGGHeader),0);
GetMem(PPacket,sizeof(TGGSendMsg));
PSendMsg := PGGSendMsg(PPacket);
PSendMsg^._seq:=0;
PSendMsg^._recipient:=Adresat;
PSendMsg^._class:=$4;
send(Sock,PSendMsg^, sizeof(TGGSendMsg),0);
send(Sock,Wiadomosc[1],length(Wiadomosc)+1,0);
send(Sock,Pointer(#0)^,sizeof(#0),0);
end;
end;
end;
end;
function TGaduGadu.UstawStatus:Boolean;
var
PPacket:Pointer;
PHeader:PGGHeader;
PNewStatus:PGGNewStatus;
begin
Result:=False;
if FConnected then begin
GetMem(PPacket,sizeof(TGGHeader));
PHeader:=PGGHeader(PPacket);
PHeader^._type:=$2;
if (FStatus=DOpis)or(FStatus=ZWOpis)or(FStatus=NWOpis)or(FStatus=NDOpis) then
PHeader^._length:=SizeOf(TGGNewStatus)+
Length(FOpis)+SizeOf(#0)
else
PHeader^._length:=SizeOf(TGGNewStatus);
send(Sock,PHeader^,sizeof(TGGHeader),0);
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGNewStatus));
PNewStatus:=PGGNewStatus(PPacket);
PNewStatus^._status:=StatusToInt(FStatus);
send(sock,PNewStatus^, SizeOf(TGGNewStatus),0);
if (FStatus=DOpis)or(FStatus=ZWOpis)or(FStatus=NWOpis)or(FStatus=NDOpis) then begin
send(sock,FOpis[1],Length(FOpis)+1,0);
send(sock,Pointer(#0)^,SizeOf(#0),0);
end;
Result:=True;
end;
end;
function TGaduGadu.Disconnect:Boolean;
begin
Result:=False;
if FConnected then begin
CloseSocket(Sock);
if Assigned(FOnDisconnect) then
FOnDisconnect(Self);
FConnected:=False;
Result:=True;
end;
end;
end.ASKER
ewangoya i try and it dont work :(
i can paste sample of code that i use but in delphi 7 it works perfectly.
i can paste sample of code that i use but in delphi 7 it works perfectly.
procedure TForm1.ZmienStatusClick(Sender: TObject);
begin
gg.Status := DOpis;
gg.Opis := 'opis discription bla bla';
gg.UstawStatus;
end;
That code works for me.
Alright, if you do not want to attach your code you can just create a smaller project with basic lines to demonstrate your issue.
Anyways, here is the final component pas file I used when tested your above code:
Alright, if you do not want to attach your code you can just create a smaller project with basic lines to demonstrate your issue.
Anyways, here is the final component pas file I used when tested your above code:
unit GaduGadu;
interface
uses
SysUtils, Classes, WinSock, Windows;
type
{Pakiety}
TGGHeader = record
_type:LongInt;
_length:LongInt;
end;
PGGHeader = ^TGGHeader;
TGGWelcome = record
_seed:LongInt;
end;
PGGWelcome = ^TGGWelcome;
TGGLogin = record
_uin: LongInt;
_hash: LongInt;
_status: LongInt;
_version: LongInt;
_unknown1: byte;
_local_ip: LongInt;
_local_port: LongInt;
_ext_ip: LongInt;
_image_size: byte;
_unknown2: byte;
end;
PGGLogin = ^TGGLogin;
TGGSendMsg = record
_recipient: LongInt;
_seq: LongInt;
_class: LongInt;
end;
PGGSendMsg = ^TGGSendMsg;
TGGMsgRichtext = record
_flag: byte;
_length: short;
end;
PGGMsgRichtext = ^TGGMsgRichtext;
TGGMsgRichtextFormat = record
_position: short;
_font: byte;
end;
PGGMsgRichtextFormat = ^TGGMsgRichTextFormat;
TGGRecvMsg = record
_sender: LongInt;
_seq: LongInt;
_time: LongInt;
_class: LongInt;
end;
PGGRecvMsg = ^TGGRecvMsg;
TGGNewStatus = record
_status: LongInt;
end;
PGGNewStatus = ^TGGNewStatus;
{Wlasne typy zmiennych}
TStatus = (D, DOpis,
ZW, ZWOpis,
NW, NWOpis,
ND, NDOpis);
{Zdarzenia}
TOnMessageEvent = procedure(Sender: TObject; MsgFrom:Integer; Wiadomosc:AnsiString) of object;
TGaduGadu = class(TComponent)
private
WSA:WSAData;
Sock:TSocket;
SockInfo:sockaddr_in;
FConnected:Boolean;
FLogin:LongInt;
FPassword:AnsiString;
FServerIP:AnsiString;
FServerPort:Integer;
FOnConnected:TNotifyEvent;
FOnMessage:TOnMessageEvent;
FOnDisconnect:TNotifyEvent;
FStatus:TStatus;
FOpis:AnsiString;
Timer:TThread;
RecvTh: TThread;
function StatusToInt(S:TStatus):LongInt;
function GGLH(Pass:AnsiString;key:LongInt):LongInt;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function ConnectEx:Boolean;
function Wyslij(Adresat:Integer;Wiadomosc:AnsiString):Boolean;
function UstawStatus:Boolean;
function Disconnect:Boolean;
published
property Login:LongInt read FLogin write FLogin;
property Haslo:AnsiString read FPassword write FPassword;
property SerwerIP:AnsiString read FServerIP write FServerIP;
property SerwerPort:Integer read FServerPort write FServerPort;
property Polaczenie:Boolean read FConnected;
property OnConnected:TNotifyEvent read FOnConnected write FOnConnected;
property Status:TStatus read FStatus write FStatus;
property OnMessage:TOnMessageEvent read FOnMessage write FOnMessage;
property OnDisconnected:TNotifyEvent read FOnDisconnect write FOnDisconnect;
property Opis:AnsiString read FOpis write FOpis;
end;
{PING/PONG}
TTimer = class(TThread)
private
GG:TGaduGadu;
protected
constructor Create(GGX: TGaduGadu);
procedure Execute; override;
end;
{ODPOWIEDZI SERWERA}
TRecvThread = class(TThread)
private
GG:TGaduGadu;
protected
constructor Create(GGX: TGaduGadu);
procedure Execute; override;
end;
procedure Register;
implementation
procedure TTimer.Execute;
var
PHeader:TGGHeader;
begin
PHeader._type:=$8;
PHeader._length:=0;
repeat
Sleep(60000);
if GG.FConnected then begin
send(GG.Sock,PHeader,sizeof(TGGHeader),0);
end;
until(false);
end;
constructor TRecvThread.Create(GGX:TGaduGadu);
begin
GG:=GGX;
inherited Create(true);
end;
constructor TTimer.Create(GGX:TGaduGadu);
begin
GG:=GGX;
inherited Create(true);
end;
procedure TRecvThread.Execute;
var
PPacket:Pointer;
RecvHeader: TGGHeader;
RecvMsg: PGGRecvMsg;
NullAnsiString:AnsiString;
NullChar:AnsiChar;
Size:Integer;
begin
repeat
Size:=recv(GG.Sock,RecvHeader,SizeOf(RecvHeader),0);
if Size < 1 then Break;
if GG.FConnected then begin
case RecvHeader._type of
$a: begin
GetMem(PPacket,SizeOf(TGGRecvMsg));
RecvMsg := PGGRecvMsg(PPacket);
recv(GG.Sock, RecvMsg^,SizeOf(TGGRecvMsg),0);
NullAnsiString:='';
repeat
recv(GG.Sock,NullChar,SizeOf(NullChar),0);
if NullChar<>#0 then NullAnsiString:=NullAnsiString+NullChar;
until NullChar=#0;
If Assigned(GG.FOnMessage) then
GG.FOnMessage(Self, RecvMsg^._sender, PAnsiChar(NullAnsiString));
end;
end;
end;
until(false);
GG.FConnected:=False;
if Assigned(GG.FOnDisconnect) then
GG.FOnDisconnect(Self);
end;
procedure Register;
begin
RegisterComponents('Inne', [TGaduGadu]);
end;
constructor TGaduGadu.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FConnected:=False;
WSAStartup(MakeWord(2,0),WSA);
Timer:=TTimer.Create(Self);
Timer.FreeOnTerminate:=false;
RecvTh:=TRecvThread.Create(Self);
RecvTh.FreeOnTerminate:=false;
end;
destructor TGaduGadu.Destroy;
begin
if FConnected then
send(Sock, Pointer($b)^, SizeOf($b), 0);
closesocket(Sock);
WSACleanUp;
Timer.Free;
RecvTh.Free;
end;
function TGaduGadu.StatusToInt(S:TStatus):LongInt;
begin
Result:=0;
case S of
D: Result:=$2;
DOpis: Result:=$4;
ZW: Result:=$3;
ZWOpis: Result:=$5;
NW: Result:=$14;
NWOpis: Result:=$16;
ND: Result:=$1;
NDOpis: Result:=$15;
end;
end;
function TGaduGadu.GGLH(Pass:AnsiString;key:LongInt):LongInt;
var
x, y, z, i :Integer;
begin
y := key;
x := 0;
for i := 1 to length(haslo) do
begin
x := (x and $ffffff00) or ord(haslo[i]);
y := y xor x;
y := y + x;
x := x shl 8;
y := y xor x;
x := x shl 8;
y := y - x;
x := x shl 8;
y := y xor x;
z := y and $1F;
y := (y shl z ) or (y shr (32-z));
end;
Result:=y;
end;
function TGaduGadu.ConnectEx:Boolean;
var
hash:LongInt;
PHeader:PGGHeader;
PWelcome:PGGWelcome;
PLogin:PGGLogin;
PPacket:Pointer;
begin
Result:=False;
if not FConnected then begin
Sock := Socket(AF_INET, SOCK_STREAM,0);
SockInfo.sin_family:=AF_INET;
SockInfo.sin_addr.s_addr:=inet_addr(PAnsiChar(FServerIP));
SockInfo.sin_port:=htons(FServerPort);
if (connect(Sock,SockInfo,SizeOf(SockInfo))<>SOCKET_ERROR) then begin
GetMem(PPacket,sizeof(TGGHeader));
recv(Sock,PPacket^,sizeof(TGGHeader),0);
PHeader := PGGHeader(PPacket);
if (PHeader^._type = $1)and
(PHeader^._length = sizeof(TGGWelcome)) then begin
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGWelcome));
recv(Sock,PPacket^,sizeof(TGGWelcome),0);
PWelcome := PGGWelcome(PPacket);
hash:=PWelcome^._seed;
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$15;
PHeader^._length:=sizeof(TGGLogin);
send(Sock,PHeader^,sizeof(TGGHeader),0);
FreeMem(PHeader);
GetMem(PPacket,sizeof(TGGLogin));
PLogin := PGGLogin(PPacket);
PLogin^._uin:=FLogin;
PLogin^._hash:=GGLH(FPassword,hash);
PLogin^._status :=StatusToInt(FStatus);
PLogin^._version:=$21;
PLogin^._image_size:=255;
PLogin^._unknown2:= $be;
send(sock,PLogin^, sizeof(TGGLogin),0);
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGHeader));
recv(Sock,PPacket^,sizeof(TGGHeader),0);
PHeader:=PGGHeader(PPacket);
if PHeader^._type=$3 then begin
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$12;
PHeader^._length:=0;
send(Sock,PHeader^,sizeof(TGGHeader),0);
FreeMem(PPacket);
Result:=True;
FConnected:=True;
if Assigned(FOnConnected) then FOnConnected(Self);
Timer.Resume;
if Assigned(RecvTh) then begin
RecvTh.Terminate;
RecvTh.Free;
RecvTh:=Nil;
RecvTh:=TRecvThread.Create(Self);
end;
RecvTh.Resume;
end else if PHeader^._type=$9 then Result:=False;
end;
end;
end;
end;
function TGaduGadu.Wyslij(Adresat:Integer;Wiadomosc:AnsiString):Boolean;
var
PPacket:Pointer;
PSendMsg:PGGSendMsg;
PHeader:PGGHeader;
TextColor:array[0..2] of Byte;
X:array of AnsiString;
S:AnsiString;
I,Y:Integer;
begin
Result:=False;
if (FConnected) then begin
S:=Wiadomosc;
if Length(S)>1988 then begin
SetLength(X,1);
Y:=0;
repeat
SetLength(X,Y+1);
X[Y]:=Copy(S,1,1988);
Delete(S,1,1988);
Inc(Y);
until(Length(S)=0);
for I:=0 to Y-1 do begin
if ((FConnected)and(X[i]<>'')and(Adresat<>0)) then begin
if Length(X[i])>1988 then
X[i]:=Copy(X[i],1,1988);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$b;
TextColor[0]:=$0;
TextColor[1]:=$0;
TextColor[2]:=$0;
PHeader^._length:=SizeOf(TGGSendMsg)+
Length(X[i])+
SizeOf(#0);
send(Sock,PHeader^,sizeof(TGGHeader),0);
GetMem(PPacket,sizeof(TGGSendMsg));
PSendMsg := PGGSendMsg(PPacket);
PSendMsg^._seq:=0;
PSendMsg^._recipient:=Adresat;
PSendMsg^._class:=$4;
send(Sock,PSendMsg^, sizeof(TGGSendMsg),0);
send(Sock,X[i][1],length(X[i])+1,0);
send(Sock,Pointer(#0)^,sizeof(#0),0);
end;
end;
end else begin
if ((FConnected)and(Wiadomosc<>'')and(Adresat<>0)) then begin
if Length(Wiadomosc)>1988 then
Wiadomosc:=Copy(Wiadomosc,1,1988);
GetMem(PPacket,sizeof(TGGHeader));
PHeader := PGGHeader(PPacket);
PHeader^._type:=$b;
TextColor[0]:=$0;
TextColor[1]:=$0;
TextColor[2]:=$0;
PHeader^._length:=SizeOf(TGGSendMsg)+
Length(Wiadomosc)+
SizeOf(#0);
send(Sock,PHeader^,sizeof(TGGHeader),0);
GetMem(PPacket,sizeof(TGGSendMsg));
PSendMsg := PGGSendMsg(PPacket);
PSendMsg^._seq:=0;
PSendMsg^._recipient:=Adresat;
PSendMsg^._class:=$4;
send(Sock,PSendMsg^, sizeof(TGGSendMsg),0);
send(Sock,Wiadomosc[1],length(Wiadomosc)+1,0);
send(Sock,Pointer(#0)^,sizeof(#0),0);
end;
end;
end;
end;
function TGaduGadu.UstawStatus:Boolean;
var
PPacket:Pointer;
PHeader:PGGHeader;
PNewStatus:PGGNewStatus;
begin
Result:=False;
if FConnected then begin
GetMem(PPacket,sizeof(TGGHeader));
PHeader:=PGGHeader(PPacket);
PHeader^._type:=$2;
if (FStatus=DOpis)or(FStatus=ZWOpis)or(FStatus=NWOpis)or(FStatus=NDOpis) then
PHeader^._length:=SizeOf(TGGNewStatus)+
Length(FOpis)+SizeOf(#0)
else
PHeader^._length:=SizeOf(TGGNewStatus);
send(Sock,PHeader^,sizeof(TGGHeader),0);
FreeMem(PPacket);
GetMem(PPacket,sizeof(TGGNewStatus));
PNewStatus:=PGGNewStatus(PPacket);
PNewStatus^._status:=StatusToInt(FStatus);
send(sock,PNewStatus^, SizeOf(TGGNewStatus),0);
if (FStatus=DOpis)or(FStatus=ZWOpis)or(FStatus=NWOpis)or(FStatus=NDOpis) then begin
send(sock,FOpis[1],Length(FOpis)+1,0);
send(sock,Pointer(#0)^,SizeOf(#0),0);
end;
Result:=True;
end;
end;
function TGaduGadu.Disconnect:Boolean;
begin
Result:=False;
if FConnected then begin
CloseSocket(Sock);
if Assigned(FOnDisconnect) then
FOnDisconnect(Self);
FConnected:=False;
Result:=True;
end;
end;
end.ASKER
ok i made sample number and password code is here:
Now i can only connect to the server and if someone send message to me i work, but sending messages fails (gg.wyslij) and changing discription ( gg.opis , gg.ustawstatus)
In delphi 7 all works. Please help :D
procedure TForm1.Button1Click(Sender: TObject);
begin
gg.Login := 33866334;
gg.Haslo := 'martynka'; //password
gg.SerwerIP := '91.214.237.16'; //host
gg.SerwerPort := 8074;
gg.ConnectEx; //connect
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
gg.Status := DOpis;
gg.Opis := 'Opis jakis tam'; // discription
gg.UstawStatus;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
gg.Wyslij(2960090,'My message to you'); //send message to number 2960090 ( my number)
end;
procedure TForm1.ggMessage(Sender: TObject; MsgFrom: Integer;
Wiadomosc: AnsiString);
begin
ShowMessage(wiadomosc); //show message with recieved message
end;Now i can only connect to the server and if someone send message to me i work, but sending messages fails (gg.wyslij) and changing discription ( gg.opis , gg.ustawstatus)
In delphi 7 all works. Please help :D
Well, this may be a hint that its about time you changed your components to something main stream.
With all the excellent client and server socket components available, why insist on code that will never be maintained (Its really not well written to begin with)
There are numerous tested and proven components, Delphi TServerSocket, TClientSocket, Indy Sockets, ICS just to mention a few
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Open in new window
next:
Open in new window
and use:
Open in new window
last use:
Open in new window
and it dont work . I can paste all lines later.