这是maozefa(之源)的代码,对我帮助很大,希望对你也有所启发,
  如果maozefa(之源)在的话,请以后多多关照//服务器主模块单元
unit ServerMain;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList, Db, DBTables, ComCtrls, StdCtrls, ExtCtrls, ADODB, Menus;const
  // 服务器在注册表的登记项路径,程序安装时自动登记
  RegPath = '\SoftWare\Zfinfo\ZfServer';
  UpdatePath = '\Software\UpdateData';
  ConnectionStr = 'Provider=SQLOLEDB.1;Password=195316;Persist Security Info=True;User ID=sa;Initial Catalog=Zfinfo';
//  ConnectionStr = 'Provider=MSDASQL.1;Password=195316;Persist Security Info=True;User ID=sa;Data Source=ZfInfoDB;Initial Catalog=ZfInfo';
type
  TServerMainForm = class(TForm)
    Image1: TImage;
    ListView1: TlistView;
    Label1: TLabel;
    ImageList1: TImageList;
    ADOConnection: TADOConnection;
    ADOQuery: TADOQuery;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
    FRecNumber: Integer;
    FSendDate: TDate;
    FSystemPath: String;
    FUpdateFlag: Integer;
    function GetRecNumber: Integer;
    procedure SetSendDate(aDate: TDate);
    procedure ClearClients;
  public
    { Public declarations }
    procedure RegUpdateFlag(Flag: Integer);
    function InsertClient: TListItem;
    // SendDate,RecNumber属性为远程数据模块自动填充信息记录
    // 主键(记录发送时间和编号)用
    property RecNumber: Integer read GetRecNumber;
    property SendDate: TDate read FSendDate write SetSendDate;
    // 系统路径
    property SystemPath: String read FSystemPath;
    // 二进制文件存取路径
    property UpdateFlag: Integer read FUpdateFlag;
  end;var
  ServerMainForm: TServerMainForm;implementationuses Registry, ServerRes;{$R *.DFM}{ TServerMainForm }
// 主Form建立事件
procedure TServerMainForm.FormCreate(Sender: TObject);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create; // 建立注册表对象,默认Root:KKEY_CURRENT_USER
  try
    if Reg.OpenKey(RegPath, False) then // 如果登记路径存在,读系统路径
      FSystemPath := Reg.ReadString('SystemPath')
    else Halt;                          // 否则程序退出(非正常安装程序)
    if Reg.OpenKey(UpdatePath, False) then
      FUpdateFlag := Reg.ReadInteger('UpdateFlag')
    else FUpdateFlag := 0;
  finally
    Reg.Free;                          // 释放注册表对象
  end;
  if SystemPath[Length(SystemPath)] <> '\' then
    FSystemPath := SystemPath + '\';
  ADOConnection.ConnectionString := ConnectionStr;
  ADOConnection.Connected := True;
  if not ADOConnection.Connected then
    ShowMessage('连接数据库失败!');
  SendDate := Date;
end;
// 从列表中清除所有已经完成任务的的客户记载
procedure TServerMainForm.ClearClients;
var
  I: Integer;
begin
  I := 0;
  while I < ListView1.Items.Count do
    if ListView1.Items.Item[I].ImageIndex = 1 then Inc(I)
    else ListView1.Items.Delete(I);
end;
// RecNumber属性(信息记录编号)的Get方法
function TServerMainForm.GetRecNumber: Integer;
begin
  Inc(FRecNumber);          // 现有记录编号+1,并返回
  Result := FRecNumber;
end;
// 在客户列表中插入一个客户记载(列表项),返回列表项
function TServerMainForm.InsertClient: TListItem;
begin
  if SendDate <> Date then  // 如果信息记录时间<>当前时间
  begin
    SendDate := Date;      // 设置信息记录时间=当前时间,取当日最大的记录编号
    ClearClients;          // 从列表中清除所有已经完成任务的的客户记载
  end;
  Result := ListView1.Items.Insert(0);
  Result.ImageIndex := 1;
end;
// SendDate属性(信息记录时间)的Put方法
procedure TServerMainForm.SetSendDate(aDate: TDate);
begin
  FSendDate := aDate;
  ADOQuery.Parameters[0].Value := aDate;
  ADOQuery.Active := True;
  FRecNumber := ADOQuery.Fields[0].AsInteger;
  ADOQuery.Active := False;
end;procedure TServerMainForm.RegUpdateFlag(Flag: Integer);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    if Reg.OpenKey(UpdatePath, True) then
      Reg.WriteInteger('UpdateFlag', Flag);
  finally
    Reg.Free;
    FUpdateFlag := Flag;
  end;
end;procedure TServerMainForm.N1Click(Sender: TObject);
begin
  ResultForm.Show;
end;procedure TServerMainForm.N2Click(Sender: TObject);
begin
  Close;
end;end.

解决方案 »

  1.   


    // 服务器远程数据模块单元
    unit ServerData;interfaceuses
      Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
      DBClient, ZfServer_TLB, StdVcl, Provider, Db, DBTables, ComCtrls, ADODB;type
      TZfInfoServer = class(TRemoteDataModule, IZfInfoServer)
        ClassProvider: TDataSetProvider;
        TypeProvider: TDataSetProvider;
        UsersProvider: TDataSetProvider;
        ItemsProvider: TDataSetProvider;
        ItemsProvider1: TDataSetProvider;
        NewProvider: TDataSetProvider;
        RecProvider: TDataSetProvider;
        ClassQuery: TADOQuery;
        TypeQuery: TADOQuery;
        UsersQuery: TADOQuery;
        ItemsQuery: TADOQuery;
        ItemsQuery1: TADOQuery;
        NewQuery: TADOQuery;
        RecQuery: TADOQuery;
        procedure RemoteDataModuleDestroy(Sender: TObject);
        procedure ItemsQueryAfterOpen(DataSet: TDataSet);
        procedure NewProviderBeforeUpdateRecord(Sender: TObject;
          SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind;
          var Applied: Boolean);
      private
        { Private declarations }
        FItem: TListItem;
      protected
        class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
        procedure SetClientInfo(const UserName, WorkInfo: WideString); safecall;
        procedure SetUpdateFlag(Flag: Integer); safecall;
      public
        { Public declarations }
      end;implementationuses ServerMain;{$R *.DFM}class procedure TZfInfoServer.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
    begin
      if Register then
      begin
        inherited UpdateRegistry(Register, ClassID, ProgID);
        EnableSocketTransport(ClassID);
        EnableWebTransport(ClassID);
      end else
      begin
        DisableSocketTransport(ClassID);
        DisableWebTransport(ClassID);
        inherited UpdateRegistry(Register, ClassID, ProgID);
      end;
    end;// 远程数据模块摧毁事件。本服务器的远程数据模块是多用户方式
    //(每客户都启用一个独立的远程数据模块)
    procedure TZfInfoServer.RemoteDataModuleDestroy(Sender: TObject);
    begin
      if Tag <> 0 then FItem.ImageIndex := 0;
    end;
    // 信息记录表Items已打开事件
    procedure TZfInfoServer.ItemsQueryAfterOpen(DataSet: TDataSet);
    var
      Code: String;
      InfoDate: TDateTime;
    begin
      if Tag = 0 then Exit;
      with TADOQuery(DataSet) do // 日记表中插入一条接收信息的记录
      begin
        Code := Parameters[2].Value;  // 在ItemsQuery参数表中取用户代码和信息时间
        InfoDate := Parameters[0].Value;
      end;
      with RecQuery do      // 设置RecQuery的SQL语句并执行
      begin
        // SQL插入语句中的字串和日期串必须用引号(单双均可),只能用ExecSQL不能用Open
        Code := '(' + #39 + Code + #39 + ',' + #39 + FormatDateTime('mm/dd/yyyy hh:mm:ss', Now) +
                #39 + ',' + #39 +  FormatDateTime('mm/dd/yyyy', InfoDate) + #39 + ')';
        SQL.Add('Insert Into QueryRec Values' + Code);
        ExecSQL;
      end;
    end;
    // NewQuery接口NewProvider的数据更新事件
    procedure TZfInfoServer.NewProviderBeforeUpdateRecord(Sender: TObject;
      SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind;
      var Applied: Boolean);
    begin
      // 如果客户程序插入信息记录同时未设定主键,
      // 从主窗口获取唯一的记录主键(发送时间和当日记录序号)
      if (UpdateKind = ukInsert) and (DeltaDS.FieldByName('NUM').Asinteger <= 0)
        and (ServerMainForm.UpdateFlag = 0) then
      begin
        DeltaDS.Edit;
        DeltaDS.FieldByName('NUM').AsInteger := ServerMainForm.RecNumber;
        DeltaDS.FieldByName('SENDDATE').AsDateTime := ServerMainForm.SendDate;
      end;
    end;
    // 以下是在类型库中自定义的客户接口过程,这些过程可由不同语言客户程序使用多种接口访问。
    // Delphi中客户一般使用连接元件的AppServer访问// 设置用户操作信息,参数:用户名,操作信息
    procedure TZfInfoServer.SetClientInfo(const UserName, WorkInfo: WideString);
    begin
      Tag := 1;                    // 使用Tag属性作标记,1表示已插入客户访问列表项
      FItem := ServerMainForm.InsertClient; // 插入并返回一个客户列表项
      FItem.Caption := UserName;    // 项标题=用户名
      FItem.SubItems.Add(WorkInfo); // 增加一个子项描述操作信息
    end;procedure TZfInfoServer.SetUpdateFlag(Flag: Integer);
    begin
      ServerMainForm.RegUpdateFlag(Flag);
    end;initialization
      TComponentFactory.Create(ComServer, TZfInfoServer,
        Class_ZfInfoServer, ciMultiInstance, tmApartment);
    end.// 一个利用聊天元件制作的用户快速回复反馈单元
    unit ServerRes;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls;type
      TResultForm = class(TForm)
        Bevel1: TBevel;
        Panel1: TPanel;
        Memo1: TMemo;
        SpeedButton1: TSpeedButton;
        ServerSocket: TServerSocket;
        SpeedButton2: TSpeedButton;
        procedure FormCreate(Sender: TObject);
        procedure ServerSocketError(Sender: TObject; Number: Smallint;
          var Description: string; Scode: Integer; const Source,
          HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
        procedure ServerSocketClientRead(Sender: TObject;
          Socket: TCustomWinSocket);
        procedure SpeedButton1Click(Sender: TObject);
        procedure SpeedButton2Click(Sender: TObject);
      protected
      end;var
      ResultForm: TResultForm;implementation{$R *.DFM}procedure TResultForm.FormCreate(Sender: TObject);
    begin
      ServerSocket.Active := True;
    end;procedure TResultForm.ServerSocketError(Sender: TObject; Number: Smallint;
      var Description: string; Scode: Integer; const Source, HelpFile: string;
      HelpContext: Integer; var CancelDisplay: Wordbool);
    begin
      ShowMessage(Description);
    end;procedure TResultForm.ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    begin
      if not Visible then Show;
      Memo1.Lines.Add(ForMatDateTime('(yyyy/mm/dd tt)', Now) + Socket.ReceiveText);
    end;procedure TResultForm.SpeedButton1Click(Sender: TObject);
    begin
      Close;
    end;procedure TResultForm.SpeedButton2Click(Sender: TObject);
    begin
      Memo1.Lines.Clear;
    end;end.
      

  2.   

    先谢谢wzsswz
     
         还有吗?但我不想看李维的东东