行业应用

开发平台：
Delphi

MainFun.~pa：源码内容
							//---------------------------------------------------------------------------
//(R)CopyRight KivenSoft International ,inc 1999
//单元名称：主窗口附属单元
//程序名称：电子书库
//作    者：李会文
//开始时间：1997.07.01
//最后修改：1999.07.15
//备注：此单元定义了主窗口一些实用函数段
//---------------------------------------------------------------------------
unit MainFun;
interface
function SaveItem:boolean;            //储存当前节点的变动内容
function SaveIndex:boolean;           //储存变动后的索引内容
function SaveSrm:boolean;             //保存主窗口中的数据库
function CloseSrm:boolean;            //关闭数据库
function CloseSrmQuery:boolean;       //是否保存对数据库的改动
function OpenSrm(Fn:string):boolean;  //打开数据库文件在主窗口中并装入索引
function BrowseFolder:string;         //目录浏览，返回被选择的目录，空为无选择
function GetLastPathName(var Pn:string):string;//提取最后的路径名
procedure SetOpenSrmWithApp(Value:boolean);//在注册表文件中设置SRM文件关联或取消
procedure ImportDir(var Dir,Mask:string);  //引入目录下文件
function FormatTreeNodeString(Value:string):string;
                                      //格式化树形视图节点字符串防止无效字符
implementation
uses
  Classes, SysUtils, Controls, Windows, Registry, Forms, ComCtrls, CommCtrl,
  Messages, FileCtrl, ShlObj, MainUnit, SrmConst, SrmUnit, InputPw, RegUnit;
//储存当前节点的变动内容--------------------------------------
function SaveItem:boolean;
var
  Ms:TMemoryStream;
  pInt:^integer;
begin
  Result:=true;
  if Srm=nil then Exit;
  with SrmForm do
  begin
    if TreeView.Selected<>nil then   //要保存的节点为空时退出
    if (Srm.ItemHeadChanged) or (TreeView.Selected.Data=pointer(-1)) then
                                          //标题属性有改变或是新增节点时
      with Srm.DataHead do
      begin
        ContextAuthorEdit.GetTextBuf(Author,16);
        ContextPasswordEdit.GetTextBuf(Password,12);
        ContextIndexEdit.GetTextBuf(SearchKey,52);
        pInt:=@DataType;
        pInt^:=TreeView.Selected.ImageIndex;
      end;
    if (SrmForm.RichEdit.Modified) or
    (SrmForm.TreeView.Selected.Data=pointer(-1)) then
                                          //内容有改变或是新增节点时
    begin
      with Srm.DataHead do
        if (RichEdit.GetTextLen<>0) then Num:=1 else Num:=0;
      TreeView.Selected.Data:=pointer(Srm.AddItemHead);
      Srm.IndexChanged:=true;             //索引改变
      if RichEdit.GetTextLen<>0 then
      begin
        Ms:=TMemoryStream.Create;
        Ms.SetSize(RichEdit.GetTextLen+1);
        RichEdit.GetTextBuf(Ms.Memory,Ms.Size);
        Srm.AddItemData(Ms);
        Ms.Free;
      end;
    end;
    if (Srm.ItemHeadChanged) and (not Srm.ItemDataChanged) and
        (not RichEdit.Modified) then      //已有节点属性改变但内容不变时
    begin
      Srm.EditItemHead(integer(TreeView.Selected.Data));
    end;
    RichEdit.Modified:=false;             //置相应的标志复位
    Srm.ItemHeadChanged:=false;
    Srm.ItemDataChanged:=false;
  end;
end;
//储存变动后的索引内容-----------------------------------
function SaveIndex:boolean;
var
  Msh,Msd:TMemoryStream;
  i,n:integer;
  p:PTreeData;
  AList:TStringList;
  ANode:TTreeNode;
begin
  Result:=true;
  if Srm=nil then Exit;
  if not Srm.IndexChanged then Exit;      //索引没改变时
  Msh:=TMemoryStream.Create;
  Msd:=TMemoryStream.Create;
  AList:=TStringList.Create;
  Msd.SetSize(sizeof(TTreeData)*SrmForm.TreeView.Items.Count);
  p:=Msd.Memory;
  n:=SrmForm.TreeView.Items.Count -1;
  ANode:=SrmForm.TreeView.Items.GetFirstNode;
  with ANode do
  begin
    for i:=0 to n do                      //添加相应级别的TAB字符
    begin
      AList.Add(StringOfChar(#9,Level)+Text);
      p^.Pos:=integer(Data);
      p^.DataType:=ImageIndex;
      ANode:=GetNext;
      p:=pointer(integer(p)+sizeof(TTreeData));
    end;
  end;
  AList.SaveToStream(Msh);
  AList.Free;
  Srm.SaveIndex(Msh,Msd);
  Srm.IndexChanged:=false;
  Msh.Free;
  Msd.Free;
end;
//保存主窗口中的数据库-------------------------------------
function SaveSrm:boolean;
begin
  Result:=true;
  if Srm=nil then Exit;
  SaveItem;
  SaveIndex;
  if Srm.DbChanged then                   //如果数据库属性有变动
  begin
    with Srm.FileHead,SrmForm do
    begin
      DbAuthorEdit.GetTextBuf(Author,16);
      DbPasswordEdit.GetTextBuf(Password,12);
      Srm.SaveSrmFile;
      Srm.IndexChanged:=false;
      Srm.DbChanged:=false;
    end;
  end;
end;
//关闭数据库-------------------------------------------
function CloseSrm:boolean;
begin
  Result:=true;
  if Srm<>nil then
  begin
    SaveSrm;
    Srm.Free;
    Srm:=nil;
  end;
  SrmForm.SearchListBox.Items.Clear;//*清空查找栏
  with SrmForm.TreeView do  //清空树形视图
  begin
    SendMessage(Handle,TVM_SELECTITEM,TVGN_CARET,LPARAM(0));
    SendMessage(Handle,WM_SETREDRAW,0,0);
                                            //禁止重绘
    SendMessage(Handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));
                                            //删除所有节点
    SendMessage(Handle,WM_SETREDRAW,-1,0);
                                            //允许重绘
    Selected:=nil;
  end;
  with SrmForm do          //编辑框和其它的清空
  begin
    RichEdit.Text:='';
    DbAuthorEdit.Text:='';
    DbPasswordEdit.Text:='';
    DbBuildDateEdit.Text:='';
    DbEditDateEdit.Text:='';
    ContextAuthorEdit.Text:='';
    ContextPasswordEdit.Text:='';
    ContextPubDateEdit.Text:='';
    ContextIndexEdit.Text:='';
    ContextTypeRadioGroup.ItemIndex:=-1;
  end;
end;
//是否保存对数据库的改动------------------------------------------
function CloseSrmQuery:boolean;
begin
  Result:=true;
  if Srm=nil then Exit;                   //没有打开的数据文件
  if not AppIni.DelRecordQuery then exit; //不提示即保存
  if (SrmForm.RichEdit.Modified or Srm.ItemDataChanged or Srm.ItemHeadChanged or
      Srm.IndexChanged or Srm.DbChanged) then
  begin
    case MessageBox(SrmForm.Handle,csSaveQuery,csAppName,MB_YESNOCANCEL or
                    MB_ICONQUESTION) of
      IDYES:Result:=true;
      IDNO:
      begin
        Result:=true;
        SrmForm.RichEdit.Modified:=false;
        Srm.ItemHeadChanged:=false;
        Srm.ItemDataChanged:=false;
        Srm.IndexChanged:=false;
        Srm.DbChanged:=false;
      end;
      IDCANCEL:Result:=false;
    end;
  end;
end;
//打开数据库文件在主窗口中并装入索引--------------------------
function OpenSrm(Fn:string):boolean;
var
  Ps,UserPs:string;
  Msh,Msd:TMemoryStream;
  i,j,n:integer;
  p:PTreeData;
  AList: TStringList;
  ALevel,AOldLevel:integer;
  AParentNode:TTreeNode;
  StrBuf:PChar;
begin
  Result:=true;
  Application.ProcessMessages;            //恢复原窗口
  Srm:=TSrmObject.Create(Fn,fmOpenReadWrite);
 if Srm.FileHead.Password[0]<>#0 then    //密码保护
  begin
    InPwForm:=TInPwForm.Create(SrmForm);
    with InPwForm do
    begin
      Caption:=csAppName;
      InputLabel.Caption:=csPasswordTitle;
      if ShowModal=mrCancel then
      begin
        Srm.Free;
        Srm:=nil;
        Free;
        Result:=false;
        Exit;
      end;
      Ps:=Edit.Text;
      UserPs:=string(Srm.FileHead.Password);
      if Ps<>UserPs then
      begin
        if ModalResult<>mrCancel then
          Application.MessageBox(csAppName,csPasswordError,MB_OK);
        Srm.Free;
        Srm:=nil;
        Result:=false;
        Free;
        Exit;
      end;
      Free;
    end;
  end;
  Screen.Cursor:=crHourGlass;
  Msh:=TMemoryStream.Create;
  Msd:=TMemoryStream.Create;
  Srm.LoadIndex(Msh,Msd);                 //装入索引
  AList := TStringList.Create;
  SrmForm.TreeView.Items.BeginUpdate;
  AList.LoadFromStream(Msh);              //装入到字符串列表中
  SendMessage(SrmForm.TreeView.Handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));
  AOldLevel := 0;
  AParentNode := nil;
  n:=AList.Count-1;
  p:=Msd.Memory;
  for i:=0 to n do                        //根据TAB的多少得到相应级别
  begin
    StrBuf:=PChar(AList.Strings[i]);
    ALevel:=0;
    while StrBuf^=#9 do                   //得该项所在层数
    begin
      Inc(StrBuf);
      Inc(ALevel);
    end;
    if (ALevel<AOldLevel) or (AParentNode<>nil) then
    begin                                 //返回该项的上级节点
      for j:=AOldLevel downto ALevel do
      begin
        AParentNode:=AParentNode.Parent;
      end;
    end;
    AParentNode:=SrmForm.TreeView.Items.AddChildObject(AParentNode,StrBuf,
                                      pointer(p.Pos));
    AParentNode.ImageIndex:=p.DataType;   //得该节点类型
    AOldLevel:=ALevel;
    p:=pointer(integer(p)+sizeof(TTreeData));
  end;
  SrmForm.TreeView.Items.EndUpdate;
  AList.Free;
  Msd.Free;
  Msh.Free;
  with Srm.FileHead,SrmForm do            //显示文件属性
  begin
    DbAuthorEdit.Text:=String(Author);
    DbPasswordEdit.Text:=String(Password);
    DbBuildDateEdit.Text:=DateToStr(BuildDate);
    DbEditDateEdit.Text:=DateToStr(EditDate);
  end;
  SrmForm.TreeView.Selected:=nil;         //置当前选择项为空
  with Srm do
  begin
    DbChanged:=false;                     //数据库变动标志复原
    IndexChanged:=false;                  //索引变动标志复原
    ItemHeadChanged:=false;
    ItemDataChanged:=false;
  end;
  Screen.Cursor:=crDefault;
end;
//目录浏览，返回被选择的目录，空为无选择---------------------------
function BrowseFolder:string;
var
  Info:TBrowseInfo;
  Dir:array[0..260] of char;
  ItemId:PItemIDList;
begin
  with Info do
  begin
    hwndOwner:=SrmForm.Handle;
    pidlRoot:=nil;
    pszDisplayName:=nil;
    lpszTitle:=csBrowseFolderInfo;
    ulFlags:=0;
    lpfn:=nil;
    lParam:=0;
    iImage:=0;
  end;
  ItemId:=SHBrowseForFolder(Info);
  if ItemId<>nil then
  begin
  SHGetPathFromIDList(ItemId,@Dir);
  Result:=string(Dir);
  end;
end;
//提取最后的路径名----------------------------------------------
function GetLastPathName(var Pn:string):string;
var
  Size:integer;
begin
  Result:=Pn;
  if Result[Length(Result)]='' then Delete(Result,Length(Result),1);
  repeat
    Size:=Pos('',Result);
    if Size>0 then Delete(Result,1,Size);
  until Size=0;
end;
//在注册表文件中设置SRM文件关联或取消-----------------------------
procedure SetOpenSrmWithApp(Value:boolean);
var
  s:string;
begin
  with TRegistry.Create do
  begin
    RootKey:=HKEY_CLASSES_ROOT;
    s:=csSrmFileType;
    if Value then                         //建立相应的键值
    begin
      OpenKey(s,true);                    //s:='.srm'
      Delete(s,1,2);
      WriteString('',s);                  //:s='srm'
      Insert('',s,1);
      OpenKey(s,true);                    //s:='srm';
      WriteString('',csSrmFileDescribe);
      OpenKey(csSrmCommand,true);
      WriteString('','"'+Application.ExeName+'" %1');
    end
    else                                  //删除相应的键值
    begin
      DeleteKey(s);
      Delete(s,2,1);
      DeleteKey(s);                       //s:='srm'
    end;
    Free;
  end;
end;
//从目录中引入--------------------------------------------------------------
procedure ImportDir(var Dir,Mask:string);
var
  SRec: TSearchRec;
  ANode,OldNode:TTreeNode;
  Path,Fn:string;
  retval,oldlen:integer;
  SubFlag,ItemFlag:boolean;
begin
  Path:=Dir;  //搜索路径
  oldlen := Length(Dir);
  retval := FindFirst( Dir+Mask,faAnyFile,SRec);
  ItemFlag:=true;
  SubFlag:=true;
  OldNode:=SrmForm.TreeView.Selected;
  ANode:=nil;
  While retval=0 Do
  Begin
    If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then //是文件
    begin
      Fn:=SRec.Name;
      Delete(Fn,Length(Fn)-3,4);
      if ItemFlag then
      begin
        ItemFlag:=false;
        ANode:=SrmForm.TreeView.Items.AddChildObjectFirst
                       (SrmForm.TreeView.Selected,Fn,pointer(-1));
      end
      else
        ANode:=SrmForm.TreeView.Items.AddObjectFirst
                       (SrmForm.TreeView.Selected,Fn,pointer(-1));
      ANode.ImageIndex:=2;  //初始化添加数据
      with Srm.DataHead do
      begin
        DataType:=2;
        Author[0]:=#0;
        Password[0]:=#0;
      end;
      SrmForm.TreeView.Selected:=ANode;
      SrmForm.RichEdit.Lines.LoadFromFile(Dir+SRec.Name);
    end;
    retval := FindNext(SRec);
  End;
  SysUtils.FindClose(SRec);
  if not ItemFlag then SrmForm.TreeView.Selected:=ANode.Parent;
  retval:=FindFirst(path+'*.*',faDirectory,SRec); //目录搜索
  While retval=0 Do
  Begin
    If (SRec.Attr and faDirectory)<>0 Then //是目录
      If (SRec.Name <> '.') and (SRec.Name <> '..') Then
      Begin
        Path:=Path+SRec.Name+'';
        if SubFlag then
        begin
          SubFlag:=false;
          ANode:=SrmForm.TreeView.Items.AddChildObjectFirst
                     (SrmForm.TreeView.Selected,GetLastPathName(Path),
                      pointer(-1));
        end
        else
          ANode:=SrmForm.TreeView.Items.AddObjectFirst
                     (SrmForm.TreeView.Selected,GetLastPathName(Path),
                      pointer(-1));
        ANode.ImageIndex:=1;
        with Srm.DataHead do
        begin
          DataType:=1;
          Author[0]:=#0;
          Password[0]:=#0;
        end;
        SrmForm.TreeView.Selected:=ANode;
        SrmForm.RichEdit.Modified:=true;
        ImportDir(path,mask);
        Delete(path,oldlen+1,260);
      End;
    retval := FindNext(SRec);
  End;
  SysUtils.FindClose(SRec);
  SrmForm.TreeView.Selected:=OldNode;
end;
//格式化树形视图节点字符串防止无效字符-----------------------------------
function FormatTreeNodeString(Value:string):string;
var
  Ap,At:pchar;
begin
  Value:=TrimLeft(Value);
  Value:=TrimRight(Value);
  Ap:=pchar(Value);
//  while Ap^ in [#1..#32] do inc(Ap);      //去掉开头小于等于空格的字符
  At:=Ap;
  while At^<>#0 do
  begin
    if At^ in [#1..#31] then At^:=#32;    //将小于空格的无效字符替换成空格
    inc(At);
  end;
  Result:=string(Ap);
end;
end.

						