dictdb.pas

迷你单词Delphi版全源吗

{**********************************************************
*                      DictDB 1.0
*                        张亚俊
*                      2001.10.27
 2002.7.9 于天津 改成使用"我也爱背单词"音标标注
 2002.10 于天津，改进搜索速度。（去掉了一些“无用”代码）
**********************************************************}
unit DictDB;
interface
uses  Classes, SysUtils, Forms, StdCtrls, ComCtrls,Dialogs, FileCtrl;

type
  TDictDB = class
  private
       // selectWordRS:TStringList;       //all词库word's
       // selectYbRS  :TStringList;       //all词库yb's
       // selectCommRS:TStringlist;       //all词库comm's
       // selectDbIndexRS:TStringList;	//当前单词所属词库id
        loadrun:boolean;
  public
        DBList:array[1..1000] of String; //所有词库名称
        DBMax:integer;          //词库数
        path:string;                     //词库path
  public
        procedure loadDictDB( DBName:String ; RS:TListView; Count:TStatusPanel );
        procedure loadDictDBToSTR(DBName:string ; WordRS:Tstringlist; YbRS:TstringList; CommRS:TStringlist);
        procedure createDictDB( dbName:string );
        procedure deleteDictDB( dbName:string );
        procedure addWord( DBName:string ; Word:string; Yb:string; Comm:string );//向当前词库add a record
        procedure delete( DBName:string; word:string );  //向当前词库delete a record
        procedure deleteOfIndex( DBName:string; index:integer );
        procedure updata( DBName:string; oldWord:string; word:string; yb:string; comm:string);
        procedure refreshDBList;                            //list all 词库
        procedure Stop;
        procedure select( text:string; exact:boolean; RS:Tlistview; Count:TStatusPanel );     //以text检索当前词库
        procedure DBRename( oldName:String; newName:String );
        function  getDBIndex( DBName:string ):integer;
        function  getDBName( DBIndex:integer ):string;
        function YBcov(YB:String):String ;
  constructor Create( dbPath:string );
end;

implementation

constructor TDictDB.Create(dbPath:string);
begin
        if trim(dbPath)='' then begin
                getdir(0,Path);
                path := path + '\data';
                end
                else path := dbPath;
        refreshDBList;
        loadrun := false;
end;

procedure TDictDB.loadDictDB( DBName:string ; RS:TListView; Count:TStatusPanel);
var fp:textfile;
    s:string;
    yb_begin,yb_end:integer;
    recordcount :integer;
    item : TlistItem;
begin
    try
        assignfile(fp, path+'\'+DBName+'.dst');
        reset(fp);
        recordcount:=0;
        loadrun := true;
        RS.Clear;
        while not eof(fp) do begin
                //application.ProcessMessages;
                inc(recordCount);
                readln(fp,s);
                yb_begin := pos('[',s);
                yb_end := pos(']',s);
                item := RS.Items.Add;
                item.Caption := inttostr(recordcount);
                item.SubItems.Add( trim(copy(s,0,yb_begin-1)) );
                item.SubItems.Add( trim(copy(s,yb_begin+1,yb_end-yb_begin-1)) );
                item.SubItems.Add( trim(copy(s,yb_end+1,length(s)-yb_end)) );
                item.SubItems.Add( inttostr(getDBIndex(DBName)) );
                if count<>nil then count.Text := '单词数量:'+inttostr(recordcount);
                if loadrun=false then begin
                        closefile(fp);
                        exit;
                end;
        end;
        closefile(fp);
        loadrun := false;
     except
     end;
end;

procedure TDictDB.loadDictDBToSTR(DBName:string ; WordRS:Tstringlist; YbRS:TstringList; CommRS:TStringlist );
var fp:textfile;
    s,YB,YBok:string;
    yb_begin,yb_end:integer;
    recordcount :integer;
begin
    try
        assignfile(fp, path+'\'+DBName+'.dst');
        reset(fp);
        loadrun := true;
        WordRS.Clear;
        Ybrs.Clear;
        commrs.Clear;
        while not eof(fp) do begin
               // application.ProcessMessages;
                readln(fp,s);
                yb_begin := pos('[',s);
                yb_end := pos(']',s);
                WordRS.Add( trim(copy(s,0,yb_begin-1)) );
                YB :=  trim(copy(s,yb_begin+1,yb_end-yb_begin-1)) ;
                YBok:=ybcov(YB);
                YbRS.Add(YBok );
                CommRS.Add( trim(copy(s,yb_end+1,length(s)-yb_end)) );
                if loadrun=false then begin
                        closefile(fp);
                        exit;
                end;
        end;
        closefile(fp);
        loadrun := false;
     except
       exit;
     end;
end;

procedure TDictDB.createDictDB( dbName:string );
var fp:textfile;
begin
        assignfile(fp,path + '\' + dbName+'.dst');
        rewrite(fp);
        closefile(fp);
        refreshDBList;
end;

procedure TDictDB.deleteDictDB( dbName:string );
begin
        deletefile(path + '\' + dbName+'.dst');
        refreshdblist;
end;

procedure TDictDB.addWord(  DBName:string ; Word:string; Yb:string; Comm:string  );
var fp:textfile;
begin
        assignfile(fp,path+'\'+DBName+'.dst');
        append(fp);
        writeln(fp,word+'['+yb+']'+comm);
        closefile(fp);
end;

procedure TDictDB.delete( DBName:string; word:string );
var fpin,fpout:textfile;
    s:string;
    yb_begin:integer;
begin
        assignfile(fpin,path+'\'+DBName+'.dst');
        assignfile(fpout,path+'\'+DBName+'.tmp');
        reset(fpin);
        rewrite(fpout);
        while not eof(fpin) do begin
             readln(fpin,s);
             yb_begin := pos('[',s);
             if copy(s,0,yb_begin-1)<>word then writeln(fpout,s);
        end;
        closefile(fpin);
        closefile(fpout);
        deletefile(path+'\'+DBName+'.dst');
        renamefile(path+'\'+DBName+'.tmp',path+'\'+DBName+'.dst');
end;

procedure TDictDB.deleteOfIndex( DBName:string; index:integer );
var fpin,fpout:textfile;
    s:string;
    i:integer;
begin
        assignfile(fpin,path+'\'+DBName+'.dst');
        assignfile(fpout,path+'\'+DBName+'.tmp');
        reset(fpin);
        rewrite(fpout);
        i:=0;
        while not eof(fpin) do begin
             inc(i);
             readln(fpin,s);
             if i<>index then writeln(fpout,s);
        end;
        closefile(fpin);
        closefile(fpout);
        deletefile(path+'\'+DBName+'.dst');
        renamefile(path+'\'+DBName+'.tmp',path+'\'+DBName+'.dst');
end;

procedure TDictDB.select( text:string; exact:boolean; RS:Tlistview; Count:TStatusPanel );
var i:integer;
    fp:textfile;
    s:string;
    yb_begin,yb_end:integer;
    item:Tlistitem;
    recordcount:integer;
    
    function delSpace(text:string):string;
     var k:integer;
     begin
        result := '';
        for k:=1 to length(text) do
            if copy(text,k,1)<>' ' then result := result + copy(text,k,1);
     end;

    procedure add();
     var j:integer;
     tmp:string;
     begin
        {for j:=0 to rs.Items.Count-1 do begin
            tmp := rs.Items[j].SubItems.Strings[0] + '[' +
                   rs.Items[j].SubItems.Strings[1] + ']' +
                   rs.Items[j].SubItems.Strings[2];
            if delSpace(s) = delSpace(tmp) then exit;
        end;  }
        inc(recordcount);
        item := RS.Items.Add;
        item.Caption := inttostr(recordcount);
        item.SubItems.Add( trim(copy(s,0,yb_begin-1)) );
        item.SubItems.Add( YBcov( trim(copy(s,yb_begin+1,yb_end-yb_begin-1)) ) );
        item.SubItems.Add( trim(copy(s,yb_end+1,length(s)-yb_end)) );
        item.SubItems.Add( dbList[i+1] );
        count.Text := '单词数量:'+inttostr(recordcount);
     end;
begin
        stop;
        loadrun := true;
        recordcount := 0;
        for i:=0 to DBmax-1 do begin
               assignfile(fp,path+'\'+dbList[i+1]+'.dst');
               reset(fp);
               while not eof(fp) do begin
                   application.ProcessMessages;
                   readln(fp,s);
                   s := trim(s);
                   yb_begin := pos('[',s);
                   yb_end := pos(']',s);
                   if exact then if text=copy(s,0,yb_begin-1) then add;
                   if exact=false then if pos(text,s)<>0 then add;
                   if (loadrun=false) then begin
                        closefile(fp);
                        exit;
                   end;
               end;
               closefile(fp);
        end;
        loadrun := false;
end;

procedure TDictDB.updata( DBName:string; oldWord:string; word:string; yb:string; comm:string);
var fpin,fpout:textfile;
    s:string;
    i:integer;
    yb_begin:integer;
begin
        assignfile(fpin,path+'\'+DBName+'.dst');
        assignfile(fpout,path+'\'+DBName+'.tmp');
        reset(fpin);
        rewrite(fpout);
        i:=0;
        while not eof(fpin) do begin
             inc(i);
             readln(fpin,s);
             yb_begin := pos('[',s);
             if oldword=copy(s,0,yb_begin-1) then s:=word+'['+yb+']'+comm;
             writeln(fpout,s);
        end;
        closefile(fpin);
        closefile(fpout);
        deletefile(path+'\'+DBName+'.dst');
        renamefile(path+'\'+DBName+'.tmp',path+'\'+DBName+'.dst');
end;

procedure TDictDB.refreshDBList;
var fListBox:TFileListBox;
    form:TForm;    
    i:integer;
    s:string;
begin
        DBMax :=0;
        form := Tform.Create(nil);
        fListbox := TFileListBox.Create(nil);
        fListbox.Mask:='*.dst';
        fListbox.Parent := form;
        fListbox.Directory := path;
        for i:=0 to fListbox.Items.Count -1 do begin
                inc(DBMax);
                s:=fListbox.Items.Strings[i];
                DBList[DBMax]:=copy(s,0,length(s)-4);
        end;
        fListbox.Free;
        fListbox := nil;
        form.Free;
        form := nil;
end;

procedure TDictDB.Stop;
begin
        if loadrun then loadrun := false;
end;

function  TDictDB.getDBIndex( DBName:string ):integer;
var i:integer;
begin
   for i:=1 to DBMax do
     if dblist[i]=DBname then
     begin
        result := i;
        exit;
     end;
end;

function  TDictDB.getDBName( DBIndex:integer ):string;
begin
        result := DBList[DBIndex];
end;

procedure TDictDB.DBRename( oldName:string; newName:string );
var i:integer;
begin
        for i:= 0 to dbmax-1 do
                if dblist[i] = oldName then begin
                        renamefile(path+'\'+oldName+'.dst',path+'\'+newName+'.dst');
                        exit;
                end;
        refreshDBlist;
end;

//音标转换(我也爱背单词)
function TDictDB.YBcov(YB:String):String ;
var
i:integer;
Tmp,YBok:String;
begin
  for i := 1 to Length(YB) do
    begin
       case YB[i] of
           '0': Tmp:='R';
           '2': Tmp:='E';
           '3': Tmp:='Q';
           '4': Tmp:='W';
           '5': Tmp:='T';
           '6': Tmp:='F';
           '7': Tmp:='V';
           '8': Tmp:='B';
           '9': Tmp:='A';
         else Tmp:=YB[i];
         end;
       YBok:=YBok+Tmp;
    end;
  Result:=YBok;
end;

end.