Ver Mensaje Individual
  #19  
Antiguo 13-07-2010
Avatar de richy08
richy08 richy08 is offline
Miembro
 
Registrado: may 2007
Ubicación: Bucerias, Nayarit Mexico
Posts: 529
Reputación: 17
richy08 Va por buen camino
a ok gracias este es el codigo del ejecutable que se encuentra en el server y mas abajo pongo el del cliente, esta linea es donde tengo el error Connection:= Myusername+'z'; //aqui marca el error no se como asignarle la conexion

//server
Código Delphi [-]
unit Interfaces;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdThreadMgr, IdThreadMgrDefault, IdBaseComponent,
  IdComponent, IdTCPServer, DB, ADODB, strutils, dateutils, ZConnection,
  ZAbstractRODataset, ZAbstractDataset, ZDataset;

type
  PClient   = ^TClient;
  TClient   = record  // Object holding data of client (see events)
  DNS         : String[20];            { Hostname }
  Connected,                           { Time of connect }
  LastAction  : TDateTime;             { Time of last transaction }
  Thread      : Pointer;               { Pointer to thread }
  end;
  
  TFrm_Interfaces = class(TForm)
    CBServerActive: TCheckBox;
    Server: TIdTCPServer;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    Protocol: TMemo;
    procedure CBServerActiveClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure ServerConnect(AThread: TIdPeerThread);
    procedure ServerDisconnect(AThread: TIdPeerThread);
    procedure ServerExecute(AThread: TIdPeerThread);
  private
    { Private declarations }
    function CreaAdo(Myusername, nombre, idext: string; acode: integer):boolean;
  public
    { Public declarations }

  end;

var
  Frm_Interfaces: TFrm_Interfaces;
  Clients         : TThreadList;     // Holds the data of all clients
  Query     : TAdoquery;
  zQuery    : TzQuery;
  zConnect1 : Tzconnection;
  i, seleccion :integer;
  
implementation

uses GlobalUnit, Prg_MDgral;

{$R *.dfm}

function TFrm_Interfaces.CreaAdo(Myusername, nombre, idext: string; acode : integer):boolean;
begin
       zConnect1:= TzConnection.Create(self);
       With zConnect1 do
       begin
        Parent:= Frm_Interfaces;
        Name:= Myusername+'z';
        Catalog:= 'lookup';
        Database:= 'cdr';
        HostName:= '192.168.11.2';
        Password:= 'system';
        Protocol:= 'mysql-5';
        port:= 3306;
        User:= 'sitisystem';
        Connect
       end;
               
       //crea el query   mssql   busca extensiones
       Query      :=   TAdoquery.Create(self);
       with Query  do
       begin
         Name :=   Myusername+'1';
         Connection:= md_gral.Con_Gral;
         SQL.text:='select idext, DesTel from pbx_ext where acode=:acode ';
         //parameters.ParamByName('acode').Value:=1;
         Parent:= Frm_Interfaces;
       end;

       //crea el query   mysql
       zQuery      :=   TzQuery.Create(self);
       with zQuery  do
       begin
         Name :=   Myusername+'2';
         Connection:= Myusername+'z';  //aqui marca el error no se como asignarle la conexion
         SQL.text:='update lookup set  allowcalls=:allowcalls, ldesc=:ldesc where code=:code ';
         {ParamByName('allowcalls').Value:=1;
         ParamByName('ldesc').Value:=nombre;
         ParamByName('code').Value:=idext;}
         Parent:= Frm_Interfaces;
       end;
end;

procedure TFrm_Interfaces.CBServerActiveClick(Sender: TObject);
begin
  Server.Active := CBServerActive.Checked;
end;



procedure TFrm_Interfaces.ServerConnect(AThread: TIdPeerThread);
var
  NewClient: PClient;
begin
GetMem(NewClient, SizeOf(TClient));

  NewClient.DNS         := AThread.Connection.LocalName;
  NewClient.Connected   := Now;
  NewClient.LastAction  := NewClient.Connected;
  NewClient.Thread      :=AThread;

  AThread.Data:=TObject(NewClient);

  try
    Clients.LockList.Add(NewClient);
  finally
    Clients.UnlockList;
  end;

  Protocol.Lines.Add(TimeToStr(Time)+' Connection from "'+NewClient.DNS+'"');
end;



procedure TFrm_Interfaces.ServerExecute(AThread: TIdPeerThread);
var
  ActClient, RecClient: PClient;                                                                              
  CommBlock, NewCommBlock: TCommBlock;
  RecThread: TIdPeerThread;
  i: Integer;
begin
  if not AThread.Terminated and AThread.Connection.Connected then
  begin
    AThread.Connection.ReadBuffer (CommBlock, SizeOf (CommBlock));
    ActClient := PClient(AThread.Data);
    ActClient.LastAction := Now;  // update the time of last action

    CreaAdo(CommBlock.MyUserName, CommBlock.nombre, CommBlock.idext, CommBlock.acode);

    Protocol.Lines.Add (TimeToStr(Time)+' !! "'+CommBlock.MyUserName);
    NewCommBlock.Command := 'DIALOG';       // the message should popup on the client's screen
    NewCommBlock.MyUserName := '[PBX Server]';  // the server's username
    NewCommBlock.Msg := 'The process was done  ';  // the message to show
    NewCommBlock.ReceiverName := '[return-to-sender]'; // unnecessary

    AThread.Connection.WriteBuffer (NewCommBlock, SizeOf (NewCommBlock), true);  // and there it goes...
  end;
end;

procedure TFrm_Interfaces.ServerDisconnect(AThread: TIdPeerThread);
var
 ActClient: PClient;
begin
  ActClient := PClient(AThread.Data);
  Protocol.Lines.Add (TimeToStr(Time)+' Disconnect from "'+ActClient^.DNS+'"');
  try
    Clients.LockList.Remove(ActClient);
  finally
    Clients.UnlockList;
  end;
  FreeMem(ActClient);
  AThread.Data := nil;
end;


procedure TFrm_Interfaces.FormCreate(Sender: TObject);
begin
  Clients := TThreadList.Create;
end;

procedure TFrm_Interfaces.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Server.Active := False;
  Clients.Free;
end;

end.


y este es el fragmento del boton de una de las pantallas que lo mandara llamar.

//client
Código Delphi [-]
.
.
.
TClientHandleThread = class(TThread)
   private
     CB: TCommBlock;
     procedure HandleInput;
   protected
     procedure Execute; override;

  end;


var
  Frm_PosGue: TFrm_PosGue;
  ClientHandleThread: TClientHandleThread;   // variable (type see above)

.
.
.
.

procedure TClientHandleThread.HandleInput;
begin
  if CB.Command = 'MESSAGE' then
     Frm_Posgue.IncomingMessages.Lines.Add (CB.MyUserName + ': ' + CB.Msg)
  else
  if CB.Command = 'DIALOG' then
    MessageDlg ('"'+CB.MyUserName+'" sends you this message:'+#13+CB.Msg, mtInformation, [mbOk], 0)
  else  // unknown command
    MessageDlg('Unknown command "'+CB.Command+'" containing this message:'+#13+CB.Msg, mtError, [mbOk], 0);
end;

procedure TClientHandleThread.Execute;
begin
  while not Terminated do
  begin
    if not Frm_Posgue.Client.Connected then
      Terminate
    else
    try
      Frm_Posgue.Client.ReadBuffer(CB, SizeOf (CB));
      Synchronize(HandleInput);
    except
    end;
  end;
end;
.
.
.

procedure TFrm_PosGue.Btb_InhClick(Sender: TObject);
var
i, seleccion :integer;
CommBlock : TCommBlock;
begin
 CBClientActive.Checked:=true;
      if CBClientActive.Checked then
      begin
        try
           Client.Connect(10000);  // in Indy < 8.1 leave the parameter away
           ClientHandleThread := TClientHandleThread.Create(True); //crea el hilo
           ClientHandleThread.FreeOnTerminate:=True; //para que no se ejecute inmediatamente
           ClientHandleThread.Resume; //lo manda ejecutar
        except
            on E: Exception do MessageDlg ('Error while connecting:'+#13+E.Message, mtError, [mbOk], 0);
        end;
      end
      else
      begin
       ClientHandleThread.Terminate;
       Client.Disconnect;
      end;

    CommBlock.Command      := '';//EditCommand.Text;         // assign the data
    CommBlock.MyUserName   := Client.LocalName;
    CommBlock.Msg          := 'hola';//EditMessage.Text;
    CommBlock.ReceiverName := 'Desarrollo-lap';//EditRecipient.Text;
    CommBlock.nconf        := Qry_principal.fieldbyname('nconf').Value;

    Client.WriteBuffer (CommBlock, SizeOf (CommBlock), true);
end;
Responder Con Cita