mainunit.pas

初次上传,不太会规类.这是一个电子文档收集的软件.支持从浏览器窗口中托拽到本地窗口中.个人以为比网文快抓,webcollecter之类的好.小,绿色,适用.

  AList.Free;
  Srm.SaveIndex(Msh,Msd);
  IndexChange:=false;
  FileChange:=true;
  Msh.Free;
  Msd.Free;

end;
//打开数据文件--------------------------------------------------------------
procedure TSrmForm.OpenSrm(Fn:string);
var
  Ps,UserPs:string;
  Msh,Msd:TMemoryStream;
  i,j,n:integer;
  p:PTreeData;
  AList: TStringList;
  ALevel,AOldLevel:integer;
  AParentNode:TTreeNode;
  StrBuf:PChar;
begin
  Application.ProcessMessages;   //恢复原窗口
  //关闭原打开的文件
  Srm:=TSrmObject.Create(Fn,fmOpenReadWrite);

  if Srm.FileHead.Password[0]<>#0 then   //密码保护
  begin
    Ps:=InputBox(csAppName,csPasswordTitle,'');
    UserPs:=string(Srm.FileHead.Password);
    if Ps<>UserPs then
    begin
      Application.MessageBox(csAppName,csPasswordError,MB_OK);
      Srm.Free;
      Srm:=nil;
      exit;
    end;
  end;

  Screen.Cursor:=crHourGlass;
  Msh:=TMemoryStream.Create;
  Msd:=TMemoryStream.Create;
  Srm.LoadIndex(Msh,Msd);        //装入索引

  AList := TStringList.Create;
  TreeView.Items.BeginUpdate;
  AList.LoadFromStream(Msh);   //装入到字符串列表中
  SendMessage(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:=TreeView.Items.AddChildObject(AParentNode,StrBuf,
                                      pointer(p.Pos));
    AParentNode.ImageIndex:=p.DataType;
    AOldLevel:=ALevel;
    p:=pointer(integer(p)+sizeof(TTreeData));
  end;
  TreeView.Items.EndUpdate;
  AList.Free;
  Msd.Free;
  Msh.Free;

  with Srm.FileHead do       //显示文件属性
  begin
    DbAuthorEdit.Text:=String(Author);
    DbPasswordEdit.Text:=String(Password);
    DbBuildDateEdit.Text:=DateToStr(BuildDate);
    DbEditDateEdit.Text:=DateToStr(EditDate);
  end;

  ActiveNode:=nil;
  TreeView.Selected:=TreeView.Items.GetFirstNode;
  FileChange:=false;
  IndexChange:=false;
  Caption:=csAppName+' - '+Srm.FileName;
  Screen.Cursor:=crDefault;
end;
//保存数据文件--------------------------------------------------------------
procedure TSrmForm.SaveSrm;
begin
  if Srm=nil then Exit;
  SaveData;
  SaveIndex;
  if FileChange then
  begin
    with Srm.FileHead do
    begin
      DbAuthorEdit.GetTextBuf(Author,16);
      DbPasswordEdit.GetTextBuf(Password,12);
    end;
    Srm.SaveSrmFile;
  end;
  RichEdit.Modified:=false;
  DataChange:=false;
  IndexChange:=false;
  FileChange:=false;
end;
//关闭数据文件--------------------------------------------------------------
procedure TSrmForm.CloseSrm;
begin
  if Srm<>nil then
  begin
    SaveSrm;
    Srm.Free;
    Srm:=nil;
  end;
  ActiveNode:=nil;
  SendMessage(TreeView.Handle,TVM_SELECTITEM,TVGN_CARET,LPARAM(0));
  SendMessage(TreeView.Handle,WM_SETREDRAW,0,0);  //禁止重绘
  SendMessage(TreeView.Handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));
  RichEdit.Text:='';
  RichEdit.Modified:=false;
  SendMessage(TreeView.Handle,WM_SETREDRAW,-1,0); //允许重绘
end;
//关闭数据文件前的询问------------------------------------------------------
function TSrmForm.CloseSrmQuery:boolean;
begin
  Result:=true;
  if Srm=nil then     //没有打开的数据文件
  begin
    RichEdit.Modified:=false;
    DataChange:=false;
    IndexChange:=false;
    FileChange:=false;
    Exit;
  end;
  if (RichEdit.Modified or DataChange or IndexChange or FileChange) then
  begin
    case Application.MessageBox(csSaveQuery,csAppName,MB_YESNOCANCEL or
                              MB_ICONQUESTION) of
      IDYES:Result:=true;
      IDNO:
      begin
        Result:=true;
        RichEdit.Modified:=false;
        DataChange:=false;
        IndexChange:=false;
        FileChange:=false;
      end;
      IDCANCEL:Result:=false;
    end;
  end
  else
    Result:=true;
end;
//目录浏览函数-------------------------------------------------------------
function TSrmForm.BrowseFolder:string;
var
  Info:TBrowseInfo;
  Dir:array[0..260] of char;
  ItemId:PItemIDList;
begin
  with Info do
  begin
    hwndOwner:=self.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 TSrmForm.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;
//从目录中引入--------------------------------------------------------------
procedure TSrmForm.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:=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)-2,3);
      if ItemFlag then
      begin
        ItemFlag:=false;
        ANode:=TreeView.Items.AddChildObjectFirst(TreeView.Selected,Fn,pointer(-1));
      end
      else
        ANode:=TreeView.Items.AddObjectFirst(TreeView.Selected,Fn,pointer(-1));
      ANode.ImageIndex:=2;
      with Srm.DataHead do
      begin
        DataType:=2;
        Author[0]:=#0;
        Password[0]:=#0;
      end;
      TreeView.Selected:=ANode;
      RichEdit.Lines.LoadFromFile(Dir+SRec.Name);
    end;
    retval := FindNext(SRec);
  End;
  FindClose(SRec);
  if not ItemFlag then 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:=TreeView.Items.AddChildObjectFirst(TreeView.Selected,
                   GetLastPathName(Path),pointer(-1));
        end
        else
          ANode:=TreeView.Items.AddObjectFirst(TreeView.Selected,
                   GetLastPathName(Path),pointer(-1));
        ANode.ImageIndex:=1;
        with Srm.DataHead do
        begin
          DataType:=1;
          Author[0]:=#0;
          Password[0]:=#0;
        end;
        TreeView.Selected:=ANode;
        RichEdit.Modified:=true;

        ImportDir(path,mask);
        Delete(path,oldlen+1,260);
      End;
    retval := FindNext(SRec);
  End;
  FindClose(SRec);
  TreeView.Selected:=OldNode;
end;




//****************************************************************
//窗体新建前----------------------------------------------------------------
procedure TSrmForm.FormCreate(Sender: TObject);
begin
  //类对象初始化
  DefaultFont:=TFont.Create;
  TitleLabel:=TMyLabel.Create(self);
  KivenLabel:=TMyLabel.Create(self);
  //两个Label的定位
  with TitleLabel do
  begin
    Parent:=RightTopPanel;
    Align:=alClient;
    ParentFont:=true;
    Font.Color:=clBlack;
    Transparent:=true;
    Caption:=csAppName;
  end;
  with KivenLabel do
  begin
    Parent:=LeftBottomPanel;
    Align:=alClient;
    ParentFont:=true;
    Font.Color:=clBlack;
    Transparent:=true;
    Caption:=csAuthor;
  end;
  //变量初始化
  ActiveNode:=nil;
  CcpNode:=nil;
  CcpMode:=0;
  RunPath:=ExtractFileDir(Application.ExeName);
end;
//窗体显示前----------------------------------------------------------------
procedure TSrmForm.FormShow(Sender: TObject);
begin
  LoadFromReg;
  if ParamCount=1 then OpenSrm(ParamStr(1))
  else if OpenedFileName[6]<>'' then
    if FileExists(OpenedFileName[6]) then OpenSrm(OpenedFileName[6]);
end;
//窗体关闭前----------------------------------------------------------------
procedure TSrmForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Srm<>nil then
    OpenedFileName[6]:=Srm.FileName
  else
    OpenedFileName[6]:='';
  if CloseSrmQuery then
    CloseSrm
  else
  begin
    Action:=caNone;
    exit;
  end;
  SaveToReg;
  Action:=caFree;
end;
//窗体被释放前--------------------------------------------------------------
procedure TSrmForm.FormDestroy(Sender: TObject);
begin
  DefaultFont.Free;
  TitleLabel.Free;
  KivenLabel.Free;
end;
//窗体改变大小--------------------------------------------------------------
procedure TSrmForm.FormResize(Sender: TObject);
begin
  if WindowState=WsNormal then
  begin
    MainWidth:=Width;
    MainHeight:=Height;
  end;
end;
procedure TsrmForm.FormMove(var Msg:TMessage);
begin
  inherited;
  if WindowState=WsNormal then
  begin
    MainLeft:=Left;
    MainTop:=Top;
  end;
end;


//****************************************************************
//查找文本---------------------------------------------------------------
procedure TSrmForm.FindDialogFind(Sender: TObject);
var
  FoundAt,StartPos,ToEnd:integer;
  SearchFlag:TSearchTypes;
begin
  if frMatchCase in FindDialog.Options then
    SearchFlag:=SearchFlag+[stMatchCase];
  if frWholeWord in FindDialog.Options then
    SearchFlag:=SearchFlag+[stWholeWord];
  StartPos:=RichEdit.SelStart+RichEdit.SelLength;
  ToEnd:=Length(RichEdit.Text)-StartPos;
  FoundAt:=RichEdit.FindText(FindDialog.FindText,StartPos,ToEnd,
                             SearchFlag);
  if FoundAt<>-1 then
  begin
    RichEdit.SetFocus;
    RichEdit.SelStart:=FoundAt;
    RichEdit.SelLength:=Length(FindDialog.FindText);
  end
  else
  begin
    Application.MessageBox(csFindError,csAppName,MB_OK or MB_ICONWARNING);
  end;
end;
//替换文本---------------------------------------------------------------
procedure TSrmForm.ReplaceDialogReplace(Sender: TObject);
var
  FoundAt,StartPos,ToEnd:integer;
  SearchFlag:TSearchTypes;
begin
  if frMatchCase in ReplaceDialog.Options then
    SearchFlag:=SearchFlag+[stMatchCase];
  if frWholeWord in ReplaceDialog.Options then
    SearchFlag:=SearchFlag+[stWholeWord];
  StartPos:=0;
  ToEnd:=Length(RichEdit.Text)-StartPos;

  if frReplace in ReplaceDialog.Options then
  begin
    StartPos:=RichEdit.SelStart+RichEdit.SelLength;
    FoundAt:=RichEdit.FindText(ReplaceDialog.FindText,StartPos,ToEnd,
                               SearchFlag);
    if FoundAt<>-1 then
    begin
      RichEdit.SetFocus;
      RichEdit.SelStart := FoundAt;