Um exemplo
necessita do odbc pick instalado e configurado na maquina.
necessita da importacao do d3clodbc.dll, e no path
necessita de odbcsrv -d no servidor, se for usar o odbc
antes de rodar o programa em delphi, rode o programa listener no pick.
este e apenas um exemplo simples
peguei algumas rotinas na internet e as juntei, corrigi e melhorei.
referencia
http://www.uri.br/~preuss/socket/socketsdelphi.html
http://groups.google.com/group/comp.databases.pick/browse_thread/thread/20a42b6be38b3a07
http://forums.tigerlogic.com/index.php?showtopic=30
Se fizerem alguma alteracao, ou implementacao com sockets, podem me enviar.
A principio, estava pensando em implementar um socket que executase um sql ou programa, e retornasse o resultado, ou
gerasse um arquivo e gravasse no /tmp para o delphi ler e processar.
O programa sender, serve para comunicacao pick a pick. surgiro pegar os originais se for o caso, no link acima.
Parece bem complicado, mas depois se entende o porque, do programa ser assim.
neba
-----------------------------------
unit TESTEP;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, D3CLODBC_TLB,
ActiveX, OleServer, StdVCL, ComObj, ScktComp;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
ClientSocket1: TClientSocket;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Label3: TLabel;
Label4: TLabel;
Edit3: TEdit;
Button2: TButton;
Button3: TButton;
ServerSocket1: TServerSocket;
Button4: TButton;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
function AsciiToHex(Texto: String): string;
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button4Click(Sender: TObject);
function HexToAscii(strData: string): string;
function InverteString2a2(strData: string): string;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
meunro, nrorec, TamBuffer: integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
aConn : clsd3connection;
anEnv : clsd3Environment;
aRec : Tclsd3DynamicArray;
aMod : clsd3RuleModule;
Afile : clsD3File;
Areg : clsD3DynamicArray;
ParamArray : PSafeArray;
ParamBounds : Array[0..0] of TSafeArrayBound;
ParamData : OleVariant;
inval,
outval : WideString;
ErrVal : longint;
tempvariant : OleVariant;
begin
ErrVal := 0;
Memo1.Lines.Add('Starting');
anEnv := CoClsD3Environment.Create;
aRec := TclsD3DynamicArray.Create(self);
if anEnv <> nil then begin
Memo1.Lines.Add('Init was ok.');
aConn := anEnv.brOpenConnection('ODBC','D3');
ErrVal := anEnv.brError(tempvariant);
if ErrVal <> 0 then
Memo1.Lines.Add('Error: ' + IntToStr(errval));
if aRec <> nil then begin
Memo1.Lines.Add('dynamic array created ok.');
aRec.brReplaceStr('val1',1,1);
aRec.brReplaceStr('val2',1,2);
aRec.brReplaceStr('val3',1,3);
aRec.brReplaceStr('val4',4);
aRec.brReplaceStr('val5',4,2);
Memo1.Lines.Add(arec.brExtractStr(1,1));
Memo1.Lines.Add(arec.brExtractStr(1,2));
Memo1.Lines.Add(arec.brExtractStr(1,3));
Memo1.Lines.Add(arec.brExtractStr(4));
Memo1.Lines.Add(arec.brExtractStr(4,2));
end;
ParamData := VarArrayCreate([0,4], varVariant);
ParamData[0] := '00019';
ParamData[1] := '11'; // retorna a descricao
ParamData[2] := '22'; // retorna o valor
ParamData[3] := ''; // retorna erros
ParamData[4] := '44'; // retorna o codigo de barras
ParamArray := PSafeArray(TVarData(ParamData).VArray);
//aMod := aConn.brOpenRuleModule('LOJA,BP.UTIL, TEST.MODULE');
aMod := aConn.brOpenRuleModule('smat.preço.flash','BP','LOJA');
Memo1.Lines.Add('brOpenRuleModule created ok.');
try
aMod.brCall(ParamArray);
if ParamData[3] <> '' then
begin
ShowMessage('Erro: ' + ParamData[3]);
exit;
end;
Memo1.Lines.Add('0 '+ParamData[0]);
Memo1.Lines.Add('1 '+ParamData[1]);
Memo1.Lines.Add('2 '+ParamData[2]);
Memo1.Lines.Add('3 '+ParamData[3]);
Memo1.Lines.Add('4 '+ParamData[4]);
except
on E : Exception do begin
ShowMessage('Exception Class: ' + e.ClassName);
ShowMessage('Exception message: ' + e.Message);
end;
end;
{
Afile := ACONN.brOpenFile('','bp.util');
Memo1.Lines.Add('Afile created ok.');
aReg := Afile.brReadu('test.module');
//aReg := Afile.brReadv('test.module',1);
aReg := Afile.brRead('test.module',1,'y');
Memo1.Lines.Add('aRec created ok.');
Memo1.Lines.Add(aReg.brExtractstr(1,1,1));
Memo1.Lines.Add(aReg.brExtractstr(2,1,1));
Memo1.Lines.Add(aReg.brExtractstr(3,1,1));
}
aRec := nil;
aMod := nil;
Afile := nil;
Areg := nil;
anEnv.brCloseConnection(aConn);
anEnv := nil;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ClientSocket1.Socket.SendText(Edit3.text);
//ClientSocket1.Socket.SendBuf(Edit3.text,sizeof(Edit3.text));
Memo1.Lines.Add('Enviou dados !');
Memo1.Lines.Add(Edit3.text);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
ClientSocket1.Host:=edit1.text;
ClientSocket1.port:=strtointdef(edit2.text,0);
ClientSocket1.Active:=true;
//
ServerSocket1.port:=strtointdef(edit2.text,0)+1;
ServerSocket1.Active:=true;
Button2.Enabled:=true;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Memo1.Clear;
Memo2.Clear;
ServerSocket1.Active:=FALSE;
ClientSocket1.Active:=FALSE;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Client Conectado!');
//Button2Click(Self);
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Client Desconectado!');
button2.Enabled:=false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
button2.Enabled:=false;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Memo1.Clear;
Memo2.Clear;
Button3Click(Self);
// Button2Click(Self);
end;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add('Server conectado!');
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add('Server Desconectado!');
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
Var
//Server
TamBuffer : integer;
texto, textobuf, textobuf1 : string;
TEXTOHEX, textohexasc, hexinv: string;
begin
TamBuffer := Socket.ReceiveLength;
texto := Socket.ReceiveText;
TEXTOHEX := AsciiToHex(TEXTO);
textohexasc := copy(HexToAscii(TEXTOHEX),1,tambuffer);
hexinv := copy(InverteString2a2(textohexasc),1,tambuffer);
memo2.Lines.Add('Server recebeu dados !');
memo2.Lines.Add('host S='+Socket.RemoteHost);
memo2.Lines.Add('ip S='+Socket.RemoteAddress);
memo2.Lines.Add('porta S='+IntToStr(Socket.RemotePort));
memo2.Lines.Add('');
memo2.Lines.Add('Texto S='+texto);
memo2.Lines.Add('TamBuffer S='+inttostr(TamBuffer));
memo2.Lines.Add('hex texto S='+ TEXTOHEX);
memo2.Lines.Add('ASCII S='+ textohexasc);
memo2.Lines.Add('inv2 S='+ hexinv);
memo2.Lines.Add('');
{ não aparece nada
Socket.ReceiveBuf(textobuf,sizeof(textobuf));
TamBuffer := Socket.ReceiveLength;
texto := textobuf;
TEXTOHEX := AsciiToHex(TEXTO);
textohexasc := copy(HexToAscii(TEXTOHEX),1,tambuffer);
hexinv := copy(InverteString2a2(textohexasc),1,tambuffer);
Memo2.Lines.Add('Server via receivebuf');
Memo2.Lines.Add('Texto ='+textobuf);
Memo2.Lines.Add('TamBuffer ='+inttostr(TamBuffer));
Memo2.Lines.Add('hex texto ='+ TEXTOHEX);
Memo2.Lines.Add('ASCII ='+ textohexasc);
Memo2.Lines.Add('inv2 ='+ hexinv);
Memo2.Lines.Add('');
}
end;
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
Var
//Cliente
TamBuffer : integer;
texto, textobuf: string;
TEXTOHEX, textohexasc, hexinv: string;
begin
TamBuffer := Socket.ReceiveLength;
texto := Socket.ReceiveText;
TEXTOHEX := AsciiToHex(TEXTO);
textohexasc := copy(HexToAscii(TEXTOHEX),1,tambuffer);
hexinv := copy(InverteString2a2(textohexasc),1,tambuffer);
Memo1.Lines.Add('Client Recebeu dados !');
Memo1.Lines.Add('host ='+Socket.RemoteHost);
Memo1.Lines.Add('ip ='+Socket.RemoteAddress);
Memo1.Lines.Add('porta='+IntToStr(Socket.RemotePort));
Memo1.Lines.Add('');
Memo1.Lines.Add('Texto ='+texto);
Memo1.Lines.Add('TamBuffer ='+inttostr(TamBuffer));
Memo1.Lines.Add('hex texto ='+TEXTOHEX);
Memo1.Lines.Add('ASCII ='+ textohexasc);
Memo1.Lines.Add('inv2 ='+ hexinv);
Memo1.Lines.Add('');
{ não aparece nada
Socket.ReceiveBuf(textobuf,sizeof(textobuf));
TamBuffer := Socket.ReceiveLength;
texto := textobuf;
TEXTOHEX := AsciiToHex(TEXTO);
textohexasc := copy(HexToAscii(TEXTOHEX),1,tambuffer);
hexinv := copy(InverteString2a2(textohexasc),1,tambuffer);
Memo1.Lines.Add('Cliente via receivebuf');
Memo1.Lines.Add('Texto ='+textobuf);
Memo1.Lines.Add('TamBuffer ='+inttostr(TamBuffer));
Memo1.Lines.Add('hex texto ='+AsciiToHex(textobuf));
Memo1.Lines.Add('ASCII ='+ textohexasc);
Memo1.Lines.Add('inv2 ='+ hexinv);
Memo1.Lines.Add('');
}
end;
function TForm1.AsciiToHex(Texto: String): string;
var
Tamanho,i : integer;
PalavraHex : String;
begin
Tamanho := Length(Texto);
for i := 1 to Tamanho do begin
PalavraHex:= PalavraHex + IntToHex(Ord(Texto[i]),1);
end;
Result := PalavraHex;
end;
function TForm1.HexToAscII(strData:string): string;
var
sresult:string;
sfinal:string;
hexc:cardinal; i:integer;
begin
i:=1;
while i<=length(strData) do
begin
hexc := strtoint('$' + copy(strData,i,2));
sresult := inttostr(hexc);
sresult := chr(strtoint(sresult));
sfinal := sfinal + sresult;
i:=i+2;
end;
result := sfinal;
end;
function TForm1.InverteString2a2(strData:string): string;
var
sresult, sresult0 :string;
sfinal:string;
i:integer;
begin
i:=1;
while i<=length(strData) do
begin
sresult0 := copy(strData,i+1,1);
sresult := copy(strData,i,1);
sfinal := sfinal + sresult0 + sresult;
i:=i+2;
end;
result := sfinal;
end;
end.
------------------------------------------------------------------------
-------------------------------------------------------------------------
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 534
ClientWidth = 688
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 40
Top = 88
Width = 39
Height = 13
Caption = 'servidor'
end
object Label2: TLabel
Left = 40
Top = 120
Width = 26
Height = 13
Caption = 'porta'
end
object Label3: TLabel
Left = 40
Top = 152
Width = 28
Height = 13
Caption = 'Texto'
end
object Label4: TLabel
Left = 40
Top = 181
Width = 68
Height = 13
Caption = 'texto a enviar'
end
object Button1: TButton
Left = 96
Top = 32
Width = 81
Height = 33
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Memo1: TMemo
Left = 16
Top = 200
Width = 577
Height = 145
Lines.Strings = (
'Memo1')
ScrollBars = ssBoth
TabOrder = 1
end
object Edit1: TEdit
Left = 152
Top = 85
Width = 121
Height = 21
TabOrder = 2
Text = '192.168.0.2'
end
object Edit2: TEdit
Left = 152
Top = 112
Width = 121
Height = 21
TabOrder = 3
Text = '3998'
end
object Edit3: TEdit
Left = 152
Top = 173
Width = 137
Height = 21
TabOrder = 4
Text = '123456789012345678901'
end
object Button2: TButton
Left = 328
Top = 174
Width = 75
Height = 20
Caption = 'enviar'
TabOrder = 5
OnClick = Button2Click
end
object Button3: TButton
Left = 328
Top = 110
Width = 75
Height = 25
Caption = 'Conectar'
TabOrder = 6
OnClick = Button3Click
end
object Button4: TButton
Left = 464
Top = 110
Width = 75
Height = 23
Caption = 'Reiniciar'
TabOrder = 7
OnClick = Button4Click
end
object Memo2: TMemo
Left = 16
Top = 368
Width = 577
Height = 145
Lines.Strings = (
'Memo1')
ScrollBars = ssBoth
TabOrder = 8
end
object ClientSocket1: TClientSocket
Active = False
ClientType = ctNonBlocking
Port = 0
OnConnect = ClientSocket1Connect
OnDisconnect = ClientSocket1Disconnect
OnRead = ClientSocket1Read
Left = 296
Top = 24
end
object ServerSocket1: TServerSocket
Active = False
Port = 0
ServerType = stNonBlocking
OnClientConnect = ServerSocket1ClientConnect
OnClientDisconnect = ServerSocket1ClientDisconnect
OnClientRead = ServerSocket1ClientRead
Left = 456
Top = 32
end
end
---------------------------------------------------------
* listener.
*
$options ext
cfunction socket.builtin
include dm,bp,includes sysid.inc
include dm,bp,unix.h socket.h
include dm,bp,unix.h errno.h
10*
char buffer[500]
var = ""
crt "socket"
sockfd=%socket( AF$INET, SOCK$STREAM, 0)
if sockfd<0 then crt "socket failed":system(0);stop
buf=char(1):char(0):char(0):char(0)
*
*Double byte swapped, buf becomes 0x0000000*
*
sockfd1=%setsockopt( sockfd, SOL$SOCKET, SO$REUSEADDR, buf, 4)
*
*Flash doesn't understand that buf is a string at this point, so the setsockopt
line in flash basic *would need to be
*fd1=%setsockopt( sockfd, SOL$SOCKET, SO$REUSEADDR, (char *) buf, 4)
*
if sockfd1<0 then crt "option failed ":system(0);go final_close
crt "bind"
status=%bind( sockfd, AF$INET, INADDR$ANY, 3998)
if status<0 then crt "bind failed ":status;go final_close
crt "listen"
number=3
status=%listen(sockfd, number)
if status<0 then crt "listen failed ":system(0);go final_close
1 * accept
crt "accept"
loop
rqm 1
addr=0;port=0
comfd=%accept( sockfd, &addr, &port)
until comfd<0 do
crt "chamado por ":addr:" puerto ":port
var=%read(comfd,buffer,500)
print "var->":var:"<-"
print "buffer->":buffer:"<-"
bufferC =buffer[1,var]
bufferresp="recebido ":bufferC
lr=len(bufferresp)
crt "enviando para ":addr:" ":port:" buffer:'":bufferresp:"', tam=":lr
n=%send( comfd, bufferresp, lr, 0)
if n<0 then
crt "envio falhou ":system(0)
end else
crt "enviado buffer ":bufferresp
end
crt "socket"
sockfd2=%socket( AF$INET, SOCK$STREAM, 0)
if sockfd2<0 then crt "socket failed":system(0);exit
ipaddr2="192.168.0.177"
port2=3998+1
crt "connecting ":ipaddr2:" porta ":port2
status2=%connect( sockfd2, AF$INET, ipaddr2, port2)
if status2 < 0 then crt "connect failed ":status;go final_close
*
2 * send
buffer2=BUFFERC
crt "send : ":buffer2
long2=len(buffer2)
n2=%send( sockfd2,buffer2, long2, 0)
if n2<0 then crt "send failed ":system(0);go final_close
if index(buffer,"fin",1) then exit
if index(buffer,"stop",1) then exit
repeat
final_close:
crt;crt 'close'
crt
status=%close(sockfd)
if index(buffer,"stop",1) then stop
goto 10
*
100* shutdown
crt 'shutdown'
status=%close(comfd)
return
----------------------------------------------------------------------
* sender
$options ext
cfunction socket.builtin
include dm,bp,includes sysid.inc
include dm,bp,unix.h socket.h
include dm,bp,unix.h errno.h
crt "socket"
sockfd=%socket( AF$INET, SOCK$STREAM, 0)
if sockfd<0 then crt "socket failed":system(0); stop
crt "connect"
ipaddr="192.168.0.2';* 172.16.127.75"
port=3998+0
status=%connect( sockfd, AF$INET, ipaddr, port)
if status<0 then crt "connect failed ":status; go final_close
*
2 * send
buffer=str(texto,50)
crt "send : ":buffer
long=len(buffer)
n=%send( sockfd, buffer, long, 0)
if n<0 then crt "send failed ":system(0); go final_close
final_close: *
crt; crt 'close'
crt
status=%close(sockfd)
*status=%closesocket(sockfd) if windows
end
--------------------------------------------------------------
subroutine smat.preço.flash(codigo, result1, result2, result3, result4)
*
* deve ser compilado em flash basic (o
*
*
ier = ""
result1="descricao"
result2="valor"
result3="";* retorna erros
result4="codigo de barras"
return
