Ir para conteúdo
Fórum Script Brasil
  • 0

Banco De Dados "pick D3"

Annelise

Perguntado por Annelise,

 Share

Pergunta

2 respostass a esta questão

Posts Recomendados

  • 0
Guest - Cleber -

Guest - Cleber -

Postado
Postado

Use ODBC que vem com o cd de instalação, ou baixe em picksys.com ou ftp://ftp.picksys.com/ . também. pode tentar Sockets.

Tem muito tem que você. postou essa dúvida, caso ainda queira usar Delphi com D3 eu posso procurar p/ você. um manual do ODBC e Sockets/D3.

cleber@multi-scDOTcomDOTbr

Link para o comentário
Compartilhar em outros sites
  • 0
neba

neba

Postado
Postado (editado) 
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

Editado por neba
Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,4k
    • Posts
      652,1k
×
×
  • Criar Novo...