picunt.pas

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

unit picunt;

interface

uses
  Windows, SysUtils,Classes,structureunt;

type
  tpic=class
      constructor Create;
      destructor  Destroy;override;
    private
      piclist:array of tpicinfo;
      procedure init_pic;
      function getmd5toid(s:string):integer;
    public
      function checkmd5pic(s:string):boolean;
      function getmd5tofile(s:string):string;
      procedure addpictolist(s:string);
  end;

implementation
uses shareunit;

function tpic.getmd5toid(s:string):integer;
var i:integer;
begin
result:=0;
if high(piclist)>0 then
for i:=low(piclist) to high(piclist) do
  if piclist[i].md5=s then
     begin
     result:=i+1;
     break;
     end;
end;

function tpic.getmd5tofile(s:string):string;
var p:integer;
begin
result:='';
p:=getmd5toid(s);
if p>0 then result:=piclist[p-1].filename;
end;

function tpic.checkmd5pic(s:string):boolean;
begin
result:=getmd5toid(s)>0;
end;

procedure tpic.addpictolist(s:string);
var md5:string;p:integer;
begin
md5:='{'+md5encodefile(s)+'}';
if getmd5toid(md5)=0 then
   begin
   p:=high(piclist)+1;
   setlength(piclist,p+1);
   piclist[p].md5:=md5;
   piclist[p].filename:=s;
   end;
end;

procedure tpic.init_pic;
var path,ext:string;
    i:integer;
    memos:tstringlist;
begin
path:=extractfilepath(application_name);
memos:=tstringlist.create;
try
FindFile(path,memos,true);
if memos.count>0 then
for i:=1 to memos.count do
  begin
  ext:=LowerCase(extractfileext(memos.strings[i-1]));
  if (ext='.jpg') or(ext='.jpeg')or(ext='.gif')or(ext='.bmp') then
      addpictolist(memos.strings[i-1]);
  end;
finally
freeandnil(memos);
end; 
end;

//------------------------------------------------------------------------------
// 创建 iconex
//------------------------------------------------------------------------------
constructor tpic.Create;
begin
init_pic;
end;

//------------------------------------------------------------------------------
// 释放 iconex
//------------------------------------------------------------------------------
destructor tpic.Destroy;
begin
  piclist:=nil;
  inherited Destroy;
end;

end.