Delphi聊天狗小程序.7z

unit main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, TFlatButtonUnit, DB, ADODB, WinSkinData, ExtCtrls, ComCtrls, Grids, DBGrids, DBGrid3D, DBCtrls; type TfrmMain = class(TForm) SaveDialog1: TSaveDialog; ADOqr: TADOQuery; SkinData1: TSkinData; PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; Panel2: TPanel; Memo1: TMemo; Panel3: TPanel; FlatButton1: TFlatButton; FlatButton2: TFlatButton; Panel1: TPanel; Label1: TLabel; Edit1: TEdit; ADOQuery1: TADOQuery; ADOQuery2: TADOQuery; DataSource1: TDataSource; DataSource2: TDataSource; Splitter1: TSplitter; ADOConnection1: TADOConnection; Panel4: TPanel; DBGrid3D2: TDBGrid3D; DBMemo1: TDBMemo; DBNavigator1: TDBNavigator; Panel5: TPanel; DBGrid3D1: TDBGrid3D; DBNavigator2: TDBNavigator; procedure FlatButton1Click(Sender: TObject); procedure Edit1KeyPress(Sender: TObject; var Key: Char); procedure FlatButton2Click(Sender: TObject); procedure DBGrid3D2TitleClick(Column: TColumn); procedure DBGrid3D1TitleClick(Column: TColumn); procedure FormShow(Sender: TObject); private { Private declarations } public { Public declarations } end; var frmMain: TfrmMain; implementation var oldMatchNum:integer;//上一匹配号 matchSting:array[1..5] of string; //匹配字符串 {$R *.dfm} procedure TfrmMain.FlatButton1Click(Sender: TObject); begin if savedialog1.Execute then memo1.Lines.SaveToFile(savedialog1.FileName ); edit1.SetFocus; end; procedure TfrmMain.Edit1KeyPress(Sender: TObject; var Key: Char); var dow:word; newMatchNum,oldNum,newNum,i,j,n,t:integer; nPos,oldnPos:integer; pass:boolean; s:string;//表中记录 begin if key=#13 then begin if length(edit1.Text)=0 then begin Application.MessageBox('不能发送空消息。', '信息', MB_OK + MB_DEFBUTTON1 + MB_ICONINFORMATION + MB_APPLMODAL); abort; end; s:=edit1.Text; edit1.Clear; memo1.Lines.Add(format('□☆☆：(%s)%s%s%s',[timetostr(now),#13#10,s,#9])); s:=lowercase(s); //取出回复记录 with ADOqr do begin close; sql.clear; sql.Add('select * from 对话表'); Open; n:=RecordCount; i:=1; while i<=n do begin //取出对话表中记录 matchSting[1]:=trim(FieldByName('对话1').AsString); matchSting[2]:=trim(FieldByName('对话2').AsString); if length(matchSting[2])>0 then matchSting[3]:=trim(FieldByName('对话3').AsString); if length(matchSting[3])>0 then matchSting[4]:=trim(FieldByName('对话4').AsString); if length(matchSting[4])>0 then matchSting[5]:=trim(FieldByName('对话5').AsString); //有效字段个数 j:=1; while (length(matchSting[j])>0) and (j<5) do inc(j); if j<5 then j:=j-1; //进行匹配对话 pass:=True; oldnpos:=0; for t:=1 to j do begin nPos:=Pos(matchSting[t],s); if (nPos=0) or (oldnpos>=npos) then pass:=false; end; //如果匹配 if pass then begin //取出编号 newNum:=j; if newNum>oldNum then begin oldNum:=newNum; newMatchNum:=FieldByName('编号').AsInteger; end; end; //下一记录 Next; inc(i); end; //取出回复 close; sql.clear; sql.Add('select * from 回复表 where 编号=:p'); //对话是否有重复 if (oldMatchNum=newMatchNum) and (oldMatchNum<>0) then parameters.ParamByName('p').Value:=newMatchNum+1 else parameters.ParamByName('p').Value:=newMatchNum; Open; //防止对话有重复,而回复表中无相应回复 if (oldMatchNum=newMatchNum) and (RecordCount=0) then begin close; sql.clear; sql.Add('select * from 回复表 where 编号=:p'); parameters.ParamByName('p').Value:=newMatchNum; Open; end; oldMatchNum:=newMatchNum; newMatchNum:=0; //随机取一个回复给s randomize; n:=1+random(RecordCount); for i:=2 to n do next; s:=FieldByName('回复').AsString; close; end; //星期几 if s='星期' then begin dow:= DayOfWeek(date); //获得星期几的信息 case Dow of 1:s:= '星期天'; 2:s:= '星期一'; 3:s:= '星期二'; 4:s:= '星期三'; 5:s:= '星期四'; 6:s:= '星期五'; 7:s:= '星期六'; end; end else if s='日期' then s:=datetostr(date) else if s='时间' then s:=timetostr(time); memo1.Lines.Add(format('■旺财：(%s)%s%s%s',[ timetostr(now),#13#10,s,#9])); end; end; procedure TfrmMain.FlatButton2Click(Sender: TObject); begin memo1.Clear; edit1.SetFocus; end; procedure TfrmMain.DBGrid3D2TitleClick(Column: TColumn); begin if ADOQuery2.RecordCount>0 then ADOQuery2.Sort:=column.FieldName; //对单击的标题进行排序 end; procedure TfrmMain.DBGrid3D1TitleClick(Column: TColumn); begin if ADOQuery1.RecordCount>0 then ADOQuery1.Sort:=column.FieldName; //对单击的标题进行排序 end; procedure TfrmMain.FormShow(Sender: TObject); begin edit1.SetFocus; end; end.