开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
ljszs.~pas
资源名称：挡案管理系统.rar　[点击查看]
上传用户：szruida
上传日期：2007-06-01
资源大小：6518k
文件大小：9k
源码类别：

Delphi控件源码

开发平台：

Delphi

ljszs.~pas：源码内容
  1. unit ljszs;
  4. interface
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   Buttons, StdCtrls, ComCtrls, ImgList, ExtCtrls, Registry, Spin, Db,
  9.   DBClient, variants, MConnect, SConnect, TFlatHintUnit, AppEvnts, ObjBrkr;
  11. type
  12.   TLjsz = class(TForm)
  13.     Panel1: TPanel;
  14.     StatusBar1: TStatusBar;
  15.     Panel2: TPanel;
  16.     Label1: TLabel;
  17.     edtAppHost: TEdit;
  18.     Label2: TLabel;
  19.     edtAppIP: TEdit;
  20.     btnAppName: TBitBtn;
  21.     Label3: TLabel;
  22.     edtPort: TEdit;
  23.     btnOK: TSpeedButton;
  24.     btnCancel: TSpeedButton;
  25.     Socket1: TSocketConnection;
  26.     Socket2: TSocketConnection;
  27.     Socket3: TSocketConnection;
  28.     ApplicationEvents1: TApplicationEvents;
  29.     Socket4: TSocketConnection;
  30.     Socket5: TSocketConnection;
  31.     Socket6: TSocketConnection;
  32.     Socket7: TSocketConnection;
  33.     procedure btnOKClick(Sender: TObject);
  34.     procedure edtAppHostExit(Sender: TObject);
  35.     procedure edtAppIPExit(Sender: TObject);
  36.     procedure btnCancelClick(Sender: TObject);
  37.     procedure btnAppNameClick(Sender: TObject);
  38.     procedure edtAppHostKeyPress(Sender: TObject; var Key: Char);
  39.     procedure edtAppIPKeyPress(Sender: TObject; var Key: Char);
  40.     procedure edtPortKeyPress(Sender: TObject; var Key: Char);
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure Socket1AfterDisconnect(Sender: TObject);
  43.     procedure Socket1BeforeDisconnect(Sender: TObject);
  44.     procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
  45.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  46.       Shift: TShiftState);
  47.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  48.     procedure ApplicationEvents1ActionExecute(Action: TBasicAction;
  49.       var Handled: Boolean);
  50.   private
  51.     //向注册表写入应用配置信息
  52.     procedure WriteToReg(const bAppHost, bAppIP, aPort: string);
  53.     { Private declarations }
  54.   public
  55.     { Public declarations }
  56.     host,ip:string;
  57.     dir:string;
  58.   end;
  60. //打开配置窗口，并测试是否连接成功
  61. function LjszExecute(aFormClass: TFormClass): boolean;
  63. var
  64.   Ljsz: TLjsz;
  65.   Connected: boolean= false; //代表是否连接成功 。
  66. implementation
  67. uses mainfrms,frmnets, logins,u_Public;
  68. {$R *.DFM}
  70. //打开配置窗口，并测试是否连接成功
  71. function LjszExecute(aFormClass: TFormClass): boolean;
  72. begin
  73.   with aFormClass.Create(Application) do
  74.   begin
  75.     Connected := False;
  76.     try
  77.       showModal;
  78.     finally
  79.       free;
  80.     end;
  81.     result := Connected;
  82.   end;
  83. end;
  85. //向注册表里写入应用服务器的配置信息
  86. procedure TLjsz.WriteToReg(const bAppHost, bAppIP, aPort: string);
  87. var
  88.   Reg: Tregistry;
  89. begin
  90.   reg := Tregistry.create;
  91.   Reg.RootKey := HKEY_LOCAL_MACHINE;
  92.   if not Reg.OpenKey('Software档案管理', False) then
  93.   begin
  94.     reg.createkey('Software档案管理');
  95.     Reg.OpenKey('Software档案管理', False);
  96.   end;
  97.   Reg.WriteString('Host', bAppHost);
  98.   Reg.WriteString('Address', bAppIP);
  99.   Reg.WriteString('Port', aPort);
  100.   reg.free;
  101. end;
  103. procedure TLjsz.btnOKClick(Sender: TObject);
  104. begin
  105.   if ((edtAppHost.text = null) or (edtAppHost.text = '')) and ((edtAppIP.text = null) or (edtAPPIP.text = '')) then
  106.   begin
  107.     Application.MessageBox('请输入应用服务器名字或IP！', '输入错误..', mb_iconinformation + mb_defbutton1);
  108.     exit;
  109.   end;
  110.   try
  111.     strtoint(edtPort.text);
  112.   except
  113.     Application.MessageBox('请输入正确的端口号', '输入错误..', mb_iconinformation + mb_defbutton1);
  114.     exit;
  115.   end;   
  117.   if trim(edtAppHost.text)<>'' then Socket1.Host := edtAppHost.text else Socket1.Address := edtAppIP.text;
  118.      Socket1.ServerName:='MMServer.MnData'; Socket1.Connected := true;
  119.   if trim(edtAppHost.text)<>'' then Socket2.Host := edtAppHost.text else Socket2.Address := edtAppIP.text;
  120.      Socket2.ServerName:='MMServer.MnData'; Socket2.Connected := true;
  121.   if trim(edtAppHost.text)<>'' then Socket3.Host := edtAppHost.text else Socket3.Address := edtAppIP.text;
  122.      Socket3.ServerName:='MMServer.MnData'; Socket3.Connected := true;
  123.   if trim(edtAppHost.text)<>'' then Socket4.Host := edtAppHost.text else Socket4.Address := edtAppIP.text;
  124.      Socket4.ServerName:='MMServer.MnData'; Socket4.Connected := true;
  125.   if trim(edtAppHost.text)<>'' then Socket5.Host := edtAppHost.text else Socket5.Address := edtAppIP.text;
  126.      Socket5.ServerName:='MMServer.MnData'; Socket5.Connected := true;
  127.   if trim(edtAppHost.text)<>'' then Socket6.Host := edtAppHost.text else Socket6.Address := edtAppIP.text;
  128.      Socket6.ServerName:='MMServer.MnData'; Socket6.Connected := true;
  129.   if trim(edtAppHost.text)<>'' then Socket7.Host := edtAppHost.text else Socket7.Address := edtAppIP.text;
  130.      Socket7.ServerName:='MMServer.MnData'; Socket7.Connected := true;
  131.   if trim(edtAppHost.text)<>'' then mainfrm.Socket1.Host := edtAppHost.text else mainfrm.Socket1.Address := edtAppIP.text;
  132.      mainfrm.Socket1.ServerName:='MMServer.MnData'; mainfrm.Socket1.Connected := true;
  133.   //-------------------------------------------------- 将客户端与中间层建立连接
  134.   ip:=trim(edtappip.Text);//主机ip
  135.   host:=trim(edtapphost.Text);//主机名
  136.   if IP<>'' then
  137.      Computer_Ip:=Ip     //主机ip
  138.   else if host<>'' then
  139.      Computer_Ip:=Host;//主机名
  140.   statusbar1.panels[0].text := '正在连接应用程序服务器，请稍候..';
  141.   statusbar1.refresh;
  142.   Screen.cursor := crHourGlass;
  143.   //---------连接socketconnection1
  144.   application.MessageBox('连接成功', '档案管理管理系统', mb_iconinformation + mb_defbutton1);
  145.   hide;
  146.   login:=tlogin.Create(application);
  147.   login.show;
  148.   //-----
  149.   screen.cursor := crdefault;
  150.   statusbar1.refresh;
  151.   exit;
  152.   //连接成功向注册表里写入应用服务器配置信息
  153.   WriteToReg(edtAppHost.Text, edtAppIP.Text, edtPort.Text);
  154.   ljsz.Hide;
  155.   //close;;
  157. end;
  159. //关闭窗口
  160. procedure TLjsz.btnCancelClick(Sender: TObject);
  161. begin
  162.  if trim(edtAppHost.text)<>'' then mainfrm.Socket1.Host := edtAppHost.text else mainfrm.Socket1.Address := edtAppIP.text;
  163.     mainfrm.Socket1.ServerName:='MMServer.MnData'; mainfrm.Socket1.Connected := true;
  164.   application.Terminate;
  165. end;
  167. //利用可视化窗体来选择计算机
  168. procedure TLjsz.btnAppNameClick(Sender: TObject);
  169. begin
  170.   edtAppIP.clear;
  171.   //NetExecute方法打开TfrmNet窗口，返回选定的计算机名
  172.   edtAppHost.text := NetExecute(TFrmNet);
  173. end;
  175. //当应用服务器名输入后，自动将应用服务器IP地址输入框置空
  176. procedure TLjsz.edtAppHostExit(Sender: TObject);
  177. begin
  178.   if edtAppHost.Text <> '' then
  179.     edtAppIP.Text := '';
  180. end;
  182. //当应用服务器IP地址输入后，自动将应用服务器名输入框置空
  183. procedure TLjsz.edtAppIPExit(Sender: TObject);
  184. begin
  185.   if edtAppIP.Text <> '' then
  186.     edtAppHost.Text := '';
  187. end;
  189. //应用服务器名输入框按键事件，当按下“回车”键后，将输入焦点转移到输入端口号输入框
  190. procedure TLjsz.edtAppHostKeyPress(Sender: TObject; var Key: Char);
  191. begin
  192.   edtAppIP.clear;
  193.   if key = #13 then
  194.     edtPort.SetFocus;
  195. end;
  197. //应用服务器IP地址输入框按键事件，当按下“回车”键后，将输入焦点转移到输入端口号输入框
  198. procedure TLjsz.edtAppIPKeyPress(Sender: TObject; var Key: Char);
  199. begin
  200.   edtAppHost.clear;
  201.   if key = #13 then
  202.     edtPort.SetFocus;
  203. end;
  205. //端口号输入框按键事件，当按下“回车”键后，调用“确定”按钮的Click方法
  206. procedure TLjsz.edtPortKeyPress(Sender: TObject; var Key: Char);
  207. begin
  208.   if key = #13 then
  209.     btnOK.click;
  210. end;
  212. procedure TLjsz.FormCreate(Sender: TObject);
  213. begin
  214.   getdir(0,dir);
  215. end;
  217. procedure TLjsz.Socket1AfterDisconnect(Sender: TObject);
  218. begin
  219.   //application.MessageBox('程序与服务器断开连接!','提示',mb_iconinformation+mb_defbutton1);
  220. end;
  222. procedure TLjsz.Socket1BeforeDisconnect(Sender: TObject);
  223. begin
  224.   //application.MessageBox('程序与服务器断开连接!','提示',mb_iconinformation+mb_defbutton1);
  225. end;
  227. procedure TLjsz.ApplicationEvents1Exception(Sender: TObject; E: Exception);
  228. var
  229.   str: string;
  230. begin
  231.   str := e.Message;
  232.   if pos('RPC服务器不可用', str)>0 then
  233.     application.MessageBox(pchar(str),'提示'mb_ok+mb_iconinformation);
  234. end;
  236. procedure TLjsz.FormKeyDown(Sender: TObject; var Key: Word;
  237.   Shift: TShiftState);
  238. begin
  239.   if key=VK_F1 then//确定
  240.      btnOkClick(Sender);
  241.   if key=VK_F3 then//取消
  242.      BtnCancelClick(Sender);
  243. end;
  245. procedure TLjsz.FormClose(Sender: TObject; var Action: TCloseAction);
  246. begin
  247.  Socket1.Connected:=false;
  248.  Socket2.Connected:=false;
  249.  Socket3.Connected:=false;
  250.  Socket4.Connected:=false;
  251.  Socket5.Connected:=false;
  252.  Socket6.Connected:=false;
  253.  Socket7.Connected:=false;
  254.  mainfrm.Socket1.Connected:=false;
  255. end;
  257. procedure TLjsz.ApplicationEvents1ActionExecute(Action: TBasicAction;
  258.   var Handled: Boolean);
  259. var str:string;
  260. begin
  261.  {str:=e.Message;
  262.  if (pos('datetime',str)>0) then
  263.     application.MessageBox('数据类型不符合要求！','提示',mb_iconExclaMation);
  264.  if (pos('Calendar',str)>0) then
  265.     application.MessageBox('数据范围有误！','提示',mb_iconExclaMation);
  266.  if (Pos('Reference 约束',str)>0) then}
  267. end;
  269. end.