pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 3

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@7 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2008-04-23 20:26:50 +00:00
parent b42ea890cc
commit a3327b25c2
4 changed files with 279 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
blcksock.pas
View File

@ -247,8 +247,8 @@ begin
if CanRead(timeout) then
begin
y:=winsock.recv(FSocket,data,1,0);
if y=0 then FLastError:=WSAENOTCONN;
sockcheck(y);
if y=0 then FLastError:=WSAENOTCONN
else sockcheck(y);
result:=data;
end
else FLastError:=WSAETIMEDOUT;

114
httpsend.pas Normal file
View File

@ -0,0 +1,114 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
|==============================================================================|
| Content: HTTP client |
|==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
| (the "License"); you may not use this file except in compliance with the |
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
| |
| Software distributed under the License is distributed on an "AS IS" basis, |
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
| the specific language governing rights and limitations under the License. |
|==============================================================================|
| The Original Code is Synapse Delphi Library. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 1999. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|==============================================================================}
unit HTTPsend;
interface
uses
Blcksock, sysutils, classes, windows, SynaUtil;
const
CRLF=#13+#10;
type
THTTPSend = class
private
Sock:TTCPBlockSocket;
public
timeout:integer;
HTTPHost:string;
HTTPPort:integer;
Constructor Create;
Destructor Destroy; override;
function Request(Query,Response:TStrings):Boolean;
end;
function get(Host,URI:string;Response:TStrings):Boolean;
implementation
{THTTPSend.Create}
Constructor THTTPSend.Create;
begin
inherited Create;
sock:=TTCPBlockSocket.create;
sock.CreateSocket;
timeout:=300;
HTTPhost:='localhost';
HTTPPort:=80;
end;
{THTTPSend.Destroy}
Destructor THTTPSend.Destroy;
begin
Sock.free;
inherited destroy;
end;
{THTTPSend.Request}
function THTTPSend.Request(Query,Response:TStrings):Boolean;
var
s:string;
n:integer;
begin
Result:=False;
sock.Connect(HTTPHost,IntToStr(HTTPPort));
if sock.lasterror<>0 then Exit;
for n:=0 to Query.Count-1 do
Sock.SendString(Query[n]+CRLF);
if Query[query.Count-1]<>'' then
Sock.SendString(CRLF);
if sock.lasterror<>0 then Exit;
repeat
s:=sock.recvstring(timeout);
Response.Add(s);
until sock.lasterror<>0;
Result:=True;
end;
{==============================================================================}
{get}
function get(Host,URI:string;Response:TStrings):Boolean;
var
s:string;
HTTP:THTTPSend;
Query:TStringList;
begin
Result:=False;
HTTP:=THTTPSend.Create;
Query:=TStringList.create;
try
HTTP.HTTPhost:=Host;
Query.Add('GET '+URI+' HTTP/0.9');
if not HTTP.Request(Query,Response) then Exit;
finally
Query.Free;
HTTP.Free;
end;
Result:=True;
end;
end.

59
smtpsend.pas
View File

@ -1,7 +1,7 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
| Project : Delphree - Synapse | 001.000.001|
|==============================================================================|
| Content: SMTP client |
| Content: SMTP client |
|==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
| (the "License"); you may not use this file except in compliance with the |
@ -27,7 +27,7 @@ unit SMTPsend;
interface
uses
Blcksock, sysutils, classes, windows;
Blcksock, sysutils, classes, windows, SynaUtil;
const
CRLF=#13+#10;
@ -51,8 +51,6 @@ type
function maildata(Value:Tstrings):Boolean;
end;
function timezone:string;
function Rfc822DateTime(t:TDateTime):String;
function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean;
implementation
@ -173,57 +171,6 @@ end;
{==============================================================================}
function timezone:string;
var
zoneinfo:TTimeZoneInformation;
bias:integer;
h,m:integer;
begin
GetTimeZoneInformation(Zoneinfo);
bias:=zoneinfo.bias;
if bias<=0 then result:='+'
else result:='-';
bias:=abs(bias);
h:=bias div 60;
m:=bias mod 60;
result:=result+format('%.2d%.2d',[h,m]);
end;
function Rfc822DateTime(t:TDateTime):String;
var
I: Integer;
SaveDayNames: array[1..7] of string;
SaveMonthNames: array[1..12] of string;
const
MyDayNames: array[1..7] of string =
('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
MyMonthNames: array[1..12] of string =
('Jan', 'Feb', 'Mar', 'Apr',
'May', 'Jun', 'Jul', 'Aug',
'Sep', 'Oct', 'Nov', 'Dec');
begin
if ShortDayNames[1] = MyDayNames[1]
then Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t)
else
begin
for I := Low(ShortDayNames) to High(ShortDayNames) do
begin
SaveDayNames[I] := ShortDayNames[I];
ShortDayNames[I] := MyDayNames[I];
end;
for I := Low(ShortMonthNames) to High(ShortMonthNames) do
begin
SaveMonthNames[I] := ShortMonthNames[I];
ShortMonthNames[I] := MyMonthNames[I];
end;
Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t);
for I := Low(ShortDayNames) to High(ShortDayNames) do
ShortDayNames[I] := SaveDayNames[I];
for I := Low(ShortMonthNames) to High(ShortMonthNames) do
ShortMonthNames[I] := SaveMonthNames[I];
end;
Result:=Result+' '+Timezone;
end;
function Sendto (mailfrom,mailto,subject,SMTPHost:string;maildata:TStrings):Boolean;
var

160
synautil.pas Normal file
View File

@ -0,0 +1,160 @@
{==============================================================================|
| Project : Delphree - Synapse | 001.000.000 |
|==============================================================================|
| Content: support procedures and functions |
|==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
| (the "License"); you may not use this file except in compliance with the |
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
| |
| Software distributed under the License is distributed on an "AS IS" basis, |
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
| the specific language governing rights and limitations under the License. |
|==============================================================================|
| The Original Code is Synapse Delphi Library. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 1999. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/) |
|==============================================================================}
unit SynaUtil;
interface
uses
Blcksock, sysutils, classes, windows;
function timezone:string;
function Rfc822DateTime(t:TDateTime):String;
function CodeInt(Value:integer):string;
function IsIP(Value:string):Boolean;
function ReverseIP(Value:string):string;
procedure Dump (Buffer:string;DumpFile:string);
implementation
{timezone}
function timezone:string;
var
zoneinfo:TTimeZoneInformation;
bias:integer;
h,m:integer;
begin
GetTimeZoneInformation(Zoneinfo);
bias:=zoneinfo.bias;
if bias<=0 then result:='+'
else result:='-';
bias:=abs(bias);
h:=bias div 60;
m:=bias mod 60;
result:=result+format('%.2d%.2d',[h,m]);
end;
{Rfc822DateTime}
function Rfc822DateTime(t:TDateTime):String;
var
I: Integer;
SaveDayNames: array[1..7] of string;
SaveMonthNames: array[1..12] of string;
const
MyDayNames: array[1..7] of string =
('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
MyMonthNames: array[1..12] of string =
('Jan', 'Feb', 'Mar', 'Apr',
'May', 'Jun', 'Jul', 'Aug',
'Sep', 'Oct', 'Nov', 'Dec');
begin
if ShortDayNames[1] = MyDayNames[1]
then Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t)
else
begin
for I := Low(ShortDayNames) to High(ShortDayNames) do
begin
SaveDayNames[I] := ShortDayNames[I];
ShortDayNames[I] := MyDayNames[I];
end;
for I := Low(ShortMonthNames) to High(ShortMonthNames) do
begin
SaveMonthNames[I] := ShortMonthNames[I];
ShortMonthNames[I] := MyMonthNames[I];
end;
Result := FormatDateTime('ddd, d mmm yyyy hh:mm:ss', t);
for I := Low(ShortDayNames) to High(ShortDayNames) do
ShortDayNames[I] := SaveDayNames[I];
for I := Low(ShortMonthNames) to High(ShortMonthNames) do
ShortMonthNames[I] := SaveMonthNames[I];
end;
Result:=Result+' '+Timezone;
end;
{CodeInt}
function CodeInt(Value:integer):string;
var
x,y:Byte;
begin
x:=Value div 256;
y:=Value mod 256;
Result:=char(y)+char(x);
end;
{IsIP}
function IsIP(Value:string):Boolean;
var
n,x:integer;
begin
Result:=true;
x:=0;
for n:=1 to Length(Value) do
if not (Value[n] in ['1'..'0','.'])
then begin
Result:=False;
break;
end
else begin
if Value[n]='.' then Inc(x);
end;
if x<>3 then Result:=False;
end;
{ReverseIP}
function ReverseIP(Value:string):string;
var
x:integer;
begin
Result:='';
repeat
x:=LastDelimiter('.',Value);
Result:=Result+Copy(Value,x,Length(Value)-x);
Delete(Value,x,Length(Value)-x);
until x<1;
if Length(Result)>0 then
if Value[1]='.' then Delete(Result, 1, 1);
end;
procedure dump (Buffer:string;DumpFile:string);
var
n:integer;
s:string;
f:Text;
begin
s:='';
for n:=1 to Length(Buffer) do
s:=s+' +#$'+IntToHex(Ord(Buffer[n]),2);
Assignfile(f,DumpFile);
if fileexists(DumpFile) then deletefile(PChar(DumpFile));
rewrite(f);
try
writeln(f,s);
finally
closefile(f);
end;
end;
end.