Simba Code:
{$loadlib ProSocks}
type
SMTP = record
{$IFNDEF CODEINSIGHT}
Addr: String;
User: String;
EUser: String;
EPass: String;
Rec: String;
FName: String;
TName: String;
Subj: String;
Msg: String;
BuffSize: Integer;
Sock: SSLSocket;
{$ENDIF}
end;
type
HTTPS = record
{$IFNDEF CODEINSIGHT}
Hdrs: Array Of String;
PKeys: Array Of String;
PVals: Array Of String;
Host: String;
Addr: String;
BuffSize: Integer;
Sock: SSLSocket;
{$ENDIF}
end;
{$IFNDEF CODEINSIGHT}
Procedure MemSet(var Buffer: String; Value: Byte; Size: Cardinal);
var
I: Integer;
Begin
For I := 1 To Length(Buffer) Do
Buffer[I] := Chr(Value);
End;
Procedure SMTP_PrintSocket(var this: SMTP);
var
Buffer: String;
Bytes_Read: Integer;
Begin
SetLength(Buffer, this.buffsize);
Repeat
{$IFDEF LAPE}
Bytes_Read := Pro_ReadSocket(this.sock, @buffer[1], this.buffsize);
{$ELSE}
Bytes_Read := Pro_ReadSocket(this.sock, buffer, this.buffsize);
{$ENDIF}
writeln(Trim(Buffer));
MemSet(Buffer, 0, this.buffsize);
If (Pro_BytesPendingSocket(this.sock) <= 0) Then
break;
Until(Bytes_Read <= 0);
End;
{$ENDIF}
Function SMTP_Create(var this: SMTP; Address: String; Port: Word; Username, Password, MailTo, Subject: String): Boolean;
{$IFNDEF LAPE}
var
PSDummy: SSLSocketType;
{$ENDIF}
begin
this.Addr := Address;
this.sock.port := Port;
this.sock.blockmode := true;
this.sock.timeout := 3000;
{$IFDEF LAPE}
this.sock.address := @this.Addr[1];
this.sock.socktype := SSLSocketType.SSL23_CLIENT_METHOD;
{$ELSE}
PSDummy := SSL23_CLIENT_METHOD;
this.sock.address := this.Addr;
this.sock.socktype := Ord(PSDummy);
{$ENDIF}
this.EUser := Base64Encode(Username);
this.EPass := Base64Encode(Password);
this.User := Username;
this.Rec := MailTo;
this.Subj := Subject;
this.BuffSize := 512;
Pro_CreateSocket(this.sock);
Result := Pro_ConnectSocket(this.sock);
end;
Procedure SMTP_Free(var this: SMTP);
begin
Pro_CloseSocket(this.sock);
Pro_FreeSocket(this.sock);
end;
Function SMTP_SendMail(var this: SMTP): Boolean;
var
Str: String;
Begin
If (this.sock.connected) Then
Begin
Str := 'EHLO ' + this.Addr + #13#10;
Pro_WriteSocket(this.sock, Str, Length(Str));
SMTP_PrintSocket(this);
Str := 'AUTH LOGIN' + #13#10;
Pro_WriteSocket(this.sock, Str, Length(Str));
SMTP_PrintSocket(this);
SMTP_PrintSocket(this);
Pro_WriteSocket(this.sock, this.EUser + #13#10, Length(this.EUser) + 2);
SMTP_PrintSocket(this);
Pro_WriteSocket(this.sock, this.EPass + #13#10, Length(this.EPass) + 2);
SMTP_PrintSocket(this);
SMTP_PrintSocket(this);
Str := 'MAIL FROM: <' + this.User + '>' + #13#10;
Pro_WriteSocket(this.sock, Str, Length(Str));
SMTP_PrintSocket(this);
Str := 'VRFY ' + this.User + #13#10;
Pro_WriteSocket(this.sock, Str, Length(Str));
SMTP_PrintSocket(this);
Str := 'RCPT TO: <' + this.Rec + '>' + #13#10;
Pro_WriteSocket(this.sock, Str, Length(Str));
SMTP_PrintSocket(this);
Pro_WriteSocket(this.sock, 'DATA' + #13#10, 6);
SMTP_PrintSocket(this);
Str := 'From: ' + this.FName + '<' + this.User + '>' + #13#10;
Str := Str + 'To: ' + this.TName + '<' + this.Rec + '>' + #13#10;
Str := Str + 'Subject: ' + this.Subj + #13#10#13#10;
Pro_WriteSocket(this.sock, Str, Length(Str));
Pro_WriteSocket(this.sock, this.Msg + #13#10 + '.' + #13#10, Length(this.Msg) + 5);
SMTP_PrintSocket(this);
Pro_WriteSocket(this.sock, 'QUIT' + #13#10, 6);
SMTP_PrintSocket(this);
Result := True;
End;
Result := False;
End;
{$IFNDEF CODEINSIGHT}
Function HTTPS_HexToInt(Hex : String): Integer;
var
Str : String;
Begin;
Str := '$' + Trim(Hex);
Result := StrToInt(Str);
If (Pos('-', Hex) > 0) Then
Result := -Result;
End;
Function HTTPS_GetHost(var this: HTTPS): String;
var
I: Integer;
Begin
Result := this.Addr;
I := Pos('://', Result);
if (I >= 0) then
Result := Copy(Result, I + 3, Length(Result) - I);
I := Pos('/', Result);
if (I > 0) then
Result := Copy(Result, 0, I - 1);
End;
Function HTTPS_GetLocation(var this: HTTPS): String;
var
I: Integer;
Begin
Result := this.Addr;
I := Pos('://', Result);
if (I >= 0) then
Result := Copy(Result, I + 3, Length(Result) - I);
I := Pos('/', Result);
if (I > 0) then
Result := Copy(Result, I + 1, Length(Result) - I);
End;
Function HTTPS_RecvLine(var this: HTTPS): String;
var
Line: String;
C: String;
Begin
SetLength(C, 1);
While(True) Do
Begin
{$IFDEF LAPE}
Pro_ReadSocket(this.sock, @C[1], 1);
{$ELSE}
Pro_ReadSocket(this.sock, C, 1);
{$ENDIF}
If (C[1] = #13) Then
Begin
{$IFDEF LAPE}
Pro_ReadSocket(this.sock, @C[1], 1);
{$ELSE}
Pro_ReadSocket(this.sock, C, 1);
{$ENDIF}
If (C[1] = #10) Then Break;
Line := Line + #13;
End Else
If (C[1] = #10) Then Break;
Line := Line + C[1];
End;
Result := Line;
End;
Function HTTPS_RecvHeader(var this: HTTPS): TStringArray;
var
I: Integer;
Line: String;
Begin
While(True) Do
Begin
Line := HTTPS_RecvLine(this);
If (Length(Line) = 0) Then Exit;
SetLength(Result, Length(Result) + 1);
Result[I] := Line;
Inc(I);
End;
End;
Function HTTPS_FindHeaderValue(var this: HTTPS; LineToFind: String): String;
var
I, H, Position: Integer;
Begin
H := High(this.Hdrs);
For I := 0 To H Do
Begin
Position := Pos(':', this.Hdrs[I]);
If ((Position > 0) And (Copy(this.Hdrs[I], 0, Position - 1) = LineToFind)) Then
Begin
Position := Pos(' ', this.Hdrs[I]);
If (Position <> 0) Then
Begin
Result := Copy(this.Hdrs[I], Position + 1, Length(this.Hdrs[I]) - Position);
Exit;
End;
End;
End;
End;
Function HTTPS_GetHeader(var this: HTTPS; Key: String): String;
Begin
If (Length(this.hdrs) <= 0) Then
this.hdrs := HTTPS_RecvHeader(this);
Result := HTTPS_FindHeaderValue(this, Key);
End;
Function HTTPS_RecvChunkSize(var this: HTTPS): Integer;
var
Line: String;
Position: Integer;
Begin
Line := HTTPS_RecvLine(this);
Position := Pos(';', Line);
If (Position <> 0) Then
Delete(Line, Position, 1);
Result := HTTPS_HexToInt(Line);
End;
Function HTTPS_ReadChunked(var this: HTTPS): String;
var
Encoding: String;
ChunkLength: Integer;
Buffer: String;
Bytes_Read: Integer;
Begin
SetLength(Buffer, this.buffsize);
MemSet(Buffer, 0, this.buffsize);
ChunkLength := 0;
Encoding := Lowercase(HTTPS_GetHeader(this, 'Transfer-Encoding'));
If (Encoding = 'chunked') Then
Begin
ChunkLength := HTTPS_RecvChunkSize(this);
While(ChunkLength <> 0) Do
Begin
{$IFDEF LAPE}
Bytes_Read := Pro_ReadSocket(this.sock, @Buffer[1], ChunkLength);
{$ELSE}
Bytes_Read := Pro_ReadSocket(this.sock, Buffer, ChunkLength);
{$ENDIF}
Result := Result + Copy(Buffer, 0, Bytes_Read);
MemSet(Buffer, 0, this.buffsize);
HTTPS_RecvLine(this);
ChunkLength := HTTPS_RecvChunkSize(this);
End;
End Else
Begin
Encoding := HTTPS_GetHeader(this, 'Content-Length');
If (Length(Encoding) > 0) Then
Begin
ChunkLength := StrToIntDef(Encoding, -1);
If (ChunkLength > 0) Then
Begin
Bytes_Read := 0;
While(Bytes_Read < ChunkLength) Do
Begin
MemSet(Buffer, 0, this.buffsize);
{$IFDEF LAPE}
Bytes_Read := Bytes_Read + Pro_ReadSocket(this.sock, @Buffer[1], this.buffsize);
{$ELSE}
Bytes_Read := Bytes_Read + Pro_ReadSocket(this.sock, Buffer, this.buffsize);
{$ENDIF}
Result := Result + Copy(Buffer, 0, Bytes_Read);
If ((Bytes_Read >= ChunkLength) or (Bytes_Read = 0)) Then
Break;
End;
End;
End Else
Begin
While(True) Do
Begin
{$IFDEF LAPE}
Bytes_Read := Pro_ReadSocket(this.sock, @Buffer[1], this.buffsize);
{$ELSE}
Bytes_Read := Pro_ReadSocket(this.sock, Buffer, this.buffsize);
{$ENDIF}
If (Bytes_Read = 0) Then
Break;
Result := Result + Copy(Buffer, 0, Bytes_Read);
MemSet(Buffer, 0, this.buffsize);
End;
End;
End;
Result := Trim(Replace(Result, #0, '', [rfReplaceAll]));
End;
Function HTTPS_KeyFound(var this: HTTPS; Generic_Key: String): Boolean;
var
I: Integer;
Begin
Result := False;
For I := 0 To High(this.pkeys) Do
Begin
If (this.pkeys[I] = Lowercase(Generic_Key)) Then
Begin
Result := True;
Exit;
End;
End;
End;
{$ENDIF}
Function HTTPS_Create(var this: HTTPS; Address: String; Port: Word): Boolean;
{$IFNDEF LAPE}
var
PSDummy: SSLSocketType;
{$ENDIF}
begin
this.Addr := Address;
this.sock.port := Port;
this.sock.blockmode := true;
this.sock.timeout := 3000;
this.Addr := HTTPS_GetHost(this);
{$IFDEF LAPE}
this.sock.address := @this.Addr[1];
this.sock.socktype := SSLSocketType.SSL23_CLIENT_METHOD;
{$ELSE}
PSDummy := SSL23_CLIENT_METHOD;
this.sock.address := this.Addr;
this.sock.socktype := Ord(PSDummy);
{$ENDIF}
this.Addr := Address;
this.buffsize := 512;
Pro_CreateSocket(this.sock);
Result := Pro_ConnectSocket(this.sock);
End;
Procedure HTTPS_Free(var this: HTTPS);
Begin
Pro_CloseSocket(this.sock);
Pro_FreeSocket(this.sock);
End;
Procedure HTTPS_ClearParameters(var this: HTTPS);
Begin
SetLength(this.pkeys, 0);
SetLength(this.pvals, 0);
End;
Function HTTPS_GetParameter(var this: HTTPS; Parameter: String): String;
var
I: Integer;
Begin
For I := 0 To High(this.pkeys) Do
If (this.pvals[I] = Lowercase(Parameter)) Then
Begin
Result := this.pvals[I];
Break;
End;
End;
Procedure HTTPS_SetParameter(var this: HTTPS; Parameter, Value: String);
var
I, L: Integer;
Exists: Boolean;
Begin
Exists := False;
L := Length(this.pvals);
For I := 0 To L - 1 Do
If (this.pvals[I] = Lowercase(Parameter)) Then
Begin
this.pvals[I] := Lowercase(Parameter);
Exists := True;
Break;
End;
If (Not Exists) Then
Begin
SetLength(this.pkeys, L + 1);
SetLength(this.pvals, L + 1);
this.pkeys[L] := Lowercase(Parameter);
this.pvals[L] := Value;
End;
End;
Function HTTPS_CreateGetHeader(var this: HTTPS): String;
var
I: Integer;
Generic_Keys: Array of String;
Generic_Values: Array of String;
Begin
Generic_Keys := ['Connection', 'User-Agent', 'Accept', 'Accept-Language', 'Accept-Charset', 'Cache-Control'];
Generic_Values := ['close', 'Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.11 (KHTML, like Gecko) Chrome/23.0.1271.97 Safari/537.11',
'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8', 'en-US,en;q=0.8', 'ISO-8859-1,UTF-8;q=0.7,*;q=0.7',
'no-cache'];
Result := 'GET /' + HTTPS_GetLocation(this) + ' HTTP/1.1' + #13#10;
Result := Result + 'Host: ' + HTTPS_GetHost(this) + #13#10;
For I := 0 To High(Generic_Keys) Do
Begin
If (HTTPS_KeyFound(this, Generic_Keys[I])) Then
Result := Result + this.pkeys[I] + ': ' + this.pvals[I] + #13#10
Else
Result := Result + Generic_Keys[I] + ': ' + Generic_Values[I] + #13#10;
End;
Result := Result + #13#10;
End;
Function HTTPS_GetPage(var this: HTTPS): String;
var
Header: String;
Begin
Header := HTTPS_CreateGetHeader(this);
Pro_WriteSocket(this.sock, Header, Length(Header));
Result := HTTPS_ReadChunked(this);
End;
Function HTTPS_GetRawPage(var this: HTTPS): String;
var
Header: String;
Buffer: String;
Bytes_Read: Integer;
Begin
Header := HTTPS_CreateGetHeader(this);
Pro_WriteSocket(this.sock, Header, Length(Header));
HTTPS_RecvHeader(this);
SetLength(Buffer, this.buffsize);
MemSet(Buffer, 0, this.buffsize);
Repeat
{$IFDEF LAPE}
Bytes_Read := Pro_ReadSocket(this.sock, @Buffer[1], this.buffsize);
{$ELSE}
Bytes_Read := Pro_ReadSocket(this.sock, Buffer, this.buffsize);
{$ENDIF}
Result := Result + Trim(Buffer);
MemSet(Buffer, 0, this.buffsize);
Until(Bytes_Read <= 0);
Result := Trim(Replace(Result, #0, '', [rfReplaceAll]));
End;