chatrec.pas

絮语2007视频聊天软件源程序.仅供参考

unit chatrec;

interface

uses
  Windows, SysUtils,Classes,structureunt,dialogs;

type
  Tchat=class
     constructor Create;
     destructor  Destroy;override;
   private
     chatreclist:array of pchatrec;
     function getchatrectoid(s:string):integer;
     procedure savetofile;
   public
     function getcount:integer;
     procedure loadfromfile;
     function getidtochatrec(n:integer):Pchatrec;
     procedure addusertext(p:pchatrec);overload;
     procedure addusertext(params:string;sendok,readok:boolean);overload;
     procedure addusertext(firendid,params:string;sendok,readok:boolean);overload;
     procedure modifychatrec(s:string;p:pchatrec);overload;
     procedure modifychatrec(n:integer;p:pchatrec);overload;
     procedure deletechatrec(s:string);overload;
     procedure deletechatrec(n:integer);overload;
     procedure getlatelylist(var tmplist:tstringlist);
   end;

implementation
uses shareunit;

function Tchat.getcount:integer;
begin
result:=high(chatreclist)+1;
end;

function Tchat.getchatrectoid(s:string):integer;
var i:integer;
begin
result:=0;
if getcount>0 then
for i:=low(chatreclist) to high(chatreclist) do
  if not chatreclist[i].nullity then
  if chatreclist[i].md5code=s then
     begin
     result:=i+1;
     break;
     end;
end;

function Tchat.getidtochatrec(n:integer):Pchatrec;
begin
result:=chatreclist[n-1];
end;

//------------------------------------------------------------------------------
// 添加聊天记录
//------------------------------------------------------------------------------
procedure Tchat.addusertext(p:pchatrec);
var n:integer;
begin
if getchatrectoid(p.md5code)=0 then
   begin
   n:=high(chatreclist)+1;
   setlength(chatreclist,n+1);
   chatreclist[n]:=p;
   end;
end;

procedure Tchat.addusertext(firendid,params:string;sendok,readok:boolean);
var tmp:pchatrec;
begin
tmp.msgtime:=strtodatetime(getparamitem(params,'dt'));
tmp.firendid:=firendid;
fillchar(tmp.msgtext, sizeof(tmp.msgtext), 0);
StrPCopy(tmp.msgtext,getparamitem(params,'msgtext'));
tmp.md5code:=md5encode(concat(tmp.firendid,randomstr,strpas(tmp.msgtext)));
tmp.sendok:=sendok;
tmp.readok:=readok;
tmp.nullity:=false;
addusertext(tmp);
end;

procedure Tchat.addusertext(params:string;sendok,readok:boolean);
var tmp:pchatrec;
begin
tmp.msgtime:=strtodatetime(getparamitem(params,'dt'));
tmp.firendid:=getparamitem(params,'firendid');
fillchar(tmp.msgtext, sizeof(tmp.msgtext), 0);
StrPCopy(tmp.msgtext,getparamitem(params,'msgtext'));
tmp.md5code:=md5encode(concat(tmp.firendid,randomstr,strpas(tmp.msgtext)));
tmp.sendok:=sendok;
tmp.readok:=readok;
tmp.nullity:=false;
addusertext(tmp);
end;

//------------------------------------------------------------------------------
// 修改
//------------------------------------------------------------------------------
procedure Tchat.modifychatrec(n:integer;p:pchatrec);
begin
chatreclist[n-1]:=p;
end;

procedure Tchat.modifychatrec(s:string;p:pchatrec);
var n:integer;
begin
n:=getchatrectoid(s);
modifychatrec(n,p);
end;

//------------------------------------------------------------------------------
// 删除
//------------------------------------------------------------------------------
procedure Tchat.deletechatrec(n:integer);
begin
chatreclist[n-1].nullity:=true;
end;

procedure Tchat.deletechatrec(s:string);
var n:integer;
begin
n:=getchatrectoid(s);
deletechatrec(n);
end;

//------------------------------------------------------------------------------
// 获取最近用户列表
//------------------------------------------------------------------------------
procedure Tchat.getlatelylist(var tmplist:tstringlist);
var i:integer;
    s:string;
begin
if getcount>0 then
for i:=high(chatreclist) downto low(chatreclist) do
  if (not chatreclist[i].nullity)and
     (not chatreclist[i].sendok) then
     begin
     s:=chatreclist[i].firendid;
     if tmplist.IndexOf(s)+1=0 then
        begin
        tmplist.Add(s);
        if tmplist.Count>9 then break;
        end;
     end; 
end;

//------------------------------------------------------------------------------
// 从文件装入
//------------------------------------------------------------------------------
procedure Tchat.loadfromfile;
var filenames:string;
    files:file of pchatrec;
    tmpuser:pchatrec;
    p:integer;
begin
filenames:=extractfilepath(application_name)+loginuser+'.rec';
if fileexists(filenames) then
  try
  assignfile(Files,filenames);
  reset(files);
  while not Eof(files) do
    begin
    read(files,tmpuser);
    if getchatrectoid(tmpuser.md5code)=0 then
       begin
       p:=high(chatreclist)+1;
       setlength(chatreclist,p+1);
       chatreclist[p]:=tmpuser;
       end;
    end;
  finally
  closefile(files);
  end;
end;

//------------------------------------------------------------------------------
// 保存列表
//------------------------------------------------------------------------------
procedure Tchat.savetofile;
var filenames:string;
    files:file of pchatrec;
    i:integer;
begin
if getcount>0 then
  try
  filenames:=extractfilepath(application_name)+loginuser+'.rec';
  assignfile(Files,filenames);
  rewrite(files);
  for i:=1 to getcount do
  if not chatreclist[i-1].nullity then
     write(files,chatreclist[i-1]);
  finally
  closefile(files);
  end;
end;

//------------------------------------------------------------------------------
// 创建 iconex
//------------------------------------------------------------------------------
constructor Tchat.Create;
begin

end;

//------------------------------------------------------------------------------
// 释放 iconex
//------------------------------------------------------------------------------
destructor Tchat.Destroy;
begin
  savetofile;
  chatreclist:=nil;
  inherited Destroy;
end;
end.