mainunit.pas

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

  begin
    DefaultExt:=csSrmExt;
    Filter:=csSrmFilter;
    Title:=csCreateTitle;
  end;
  if SaveDialog.Execute then
  begin
    if CloseSrmQuery then CloseSrm else exit;
    Srm:=TSrmObject.Create(SaveDialog.FileName,fmCreate);
    DbAuthorEdit.Text:='';
    DbPasswordEdit.Text:='';
    DbBuildDateEdit.Text:=DateToStr(Srm.FileHead.BuildDate);
    DbeditDateEdit.Text:=DatetoStr(Srm.FileHead.EditDate);
    Caption:=csAppName+' - '+SaveDialog.FileName;
  end;
end;
//打开数据文件------------------------------------------------------------
procedure TSrmForm.OpenMenuItemClick(Sender: TObject);
begin
  with OpenDialog do
  begin
    DefaultExt:=csSrmExt;
    Filter:=csSrmFilter;
    Title:=csOpenTitle;
  end;
  if OpenDialog.Execute then
  begin
    if CloseSrmQuery then CloseSrm else exit;
    OpenSrm(OpenDialog.FileName);
  end;
end;
//保存数据文件------------------------------------------------------------
procedure TSrmForm.SaveMenuItemClick(Sender: TObject);
begin
  SaveSrm;
end;
//关闭数据文件------------------------------------------------------------
procedure TSrmForm.CloseMenuItemClick(Sender: TObject);
begin
  if CloseSrmQuery then
  begin
    CloseSrm;
    Caption:=csAppName;
  end;
end;
//文件引入-----------------------------------------------------------------
procedure TSrmForm.FImportMenuItemClick(Sender: TObject);
var
  ANode:TTreeNode;
  i,n:integer;
  Fn:string;
begin
  with OpenDialog do
  begin
    DefaultExt:=csTxtExt;
    Filter:=csTxtFilter;
    Title:=csOpenTitle;
  end;
  if OpenDialog.Execute then
  begin
    n:=OpenDialog.Files.Count-1;
    SendMessage(RichEdit.Handle,WM_SETREDRAW,0,0);  //禁止重绘
    for i:=0 to n do  //循环读入多重选择文件
    begin
      Fn:=ExtractFileName(OpenDialog.Files.Strings[i]);
      Delete(Fn,Length(Fn)-2,3);
      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(OpenDialog.Files.Strings[i]);
    end;
    StatusBar.Refresh;
    SendMessage(RichEdit.Handle,WM_SETREDRAW,-1,0);  //允许重绘
  end;
end;
//目录引入-----------------------------------------------------------------
procedure TSrmForm.DImportMenuItemClick(Sender: TObject);
var
  Dir,Mask:string;
  ANode:TTreeNode;
begin
  Dir:=BrowseFolder;
  If Dir='' Then exit;
  ANode:=TreeView.Items.AddChildObjectFirst(TreeView.Selected,
       GetLastPathName(Dir),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;
  if Dir[Length(Dir)]<>'\' then Dir:=Dir+'\';
  Mask:='*.'+csTxtExt;
  Screen.Cursor:=crHourGlass;
  SendMessage(RichEdit.Handle,WM_SETREDRAW,0,0);  //禁止重绘
  ImportDir(Dir,Mask);
  SendMessage(RichEdit.Handle,WM_SETREDRAW,-1,0);  //允许重绘
  StatusBar.Refresh;
  SCreen.Cursor:=crDefault;
end;
//导出标题内容--------------------------------------------------------------
procedure TSrmForm.ExportMenuItemClick(Sender: TObject);
var
  Dir:string;
//  i,n:integer;     //对别的格式要导出其附件

  function FormatFileName(Fn:string):string;
  var
    i,n:integer;
    c:char;
  begin
    Result:=Fn;
    n:=Length(Result);
    for i:=1 to n do
    begin
      c:=Result[i];
      if ((c=#92) or (c=#47) or (c=#58) or (c=#42) or (c=#63) or
           (c=#34) or (c=#60) or (c=#62) or (c=#124)) then
        Result[i]:='$';  //替换掉系统不接受的文件命名的字符
    end;
  end;
  procedure OutPutSrm(ANode:TTreeNode;Dir:string);
  var
    SNode:TTreeNode;
    Ms:TMemoryStream;
    Fh:integer;
    Path:string;
  begin
    Ms:=TMemoryStream.Create;
    Path:=Dir;
    SNode:=ANode.GetFirstChild;
    while SNode<>nil do
    begin
      if SNode.ImageIndex=1 then
      begin
        Dir:=Path+FormatFileName(SNode.Text);
        MkDir(Dir);
        Dir:=Dir+'\';
        OutPutSrm(SNode,Dir);
      end
      else
      begin
        Srm.ReadItemHead(integer(SNode.Data));
        if ((Srm.DataHead.Password[0]=#0) and (Srm.DataHead.Num=1)) then
        begin       //没有口令的内容才导出
          Srm.ReadItemData(Ms);
          Fh:=FileCreate(Path+FormatFileName(SNode.Text)+'.'+csTxtExt);
          if Fh<>0 then FileWrite(Fh,Ms.Memory^,Ms.Size);
          FileClose(Fh);
        end;
      end;
      SNode:=SNode.GetNextSibling;
    end;
    Ms.Free;
  end;
begin
  if TreeView.Selected=nil then exit;
  if TreeView.Selected.GetFirstChild=nil then
  begin
    with SaveDialog do
    begin
      DefaultExt:=csTxtExt;
      Filter:=csTxtFilter;
      Title:=csSaveAsTitle;
      FileName:=TreeView.Selected.Text;
    end;
    if SaveDialog.Execute then
    begin
      RichEdit.Lines.SaveToFile(SaveDialog.FileName);
    end;
  end
  else
  begin
    Dir:=BrowseFolder;
    If Dir='' Then exit;
    if Dir[Length(Dir)]<>'\' then Dir:=Dir+'\';
    Dir:=Dir+FormatFileName(TreeView.Selected.Text);
    if DirectoryExists(Dir) then
    begin
      Application.MessageBox(csDirExists,csAppName,MB_OK or MB_ICONERROR);
      exit;
    end;
    MkDir(Dir);
    Dir:=Dir+'\';
    Screen.Cursor:=crHourGlass;
    OutPutSrm(TreeView.Selected,Dir);
    Screen.Cursor:=crDefault;
  end;
end;
//打印内容------------------------------------------------------------------
procedure TSrmForm.PrintMenuItemClick(Sender: TObject);
begin
  if RichEdit.GetTextLen()=0 then
    RichEdit.Print(TitleLabel.Caption);
end;
//退出菜单-----------------------------------------------------------------
procedure TSrmForm.ExitMenuItemClick(Sender: TObject);
begin
    Close;
end;
//我的最爱-----------------------------------------------------------------
procedure TSrmForm.MyLoveMenuItemClick(Sender: TObject);
begin
  if CloseSrmQuery then CloseSrm else exit;
  if OpenedFileName[0]<>'' then
    if FileExists(OpenedFileName[0]) then OpenSrm(OpenedFileName[0]);
  if Srm=nil then
    Caption:=csAppName
  else
    Caption:=csAppName+OpenedFileName[0];
end;



//****************************************************************
//恢复菜单----------------------------------------------------------------
procedure TSrmForm.UndoMenuItemClick(Sender: TObject);
begin
  SendMessage(RichEdit.Handle,EM_UNDO,0,0);
end;

//---------------------------------------------------------------------
procedure TSrmForm.RedoMenuItemClick(Sender: TObject);
begin
  SendMessage(RichEdit.Handle,EM_UNDO,0,0);
end;

//重做菜单--------------------------------------------------------------
procedure TSrmForm.CutMenuItemClick(Sender: TObject);
begin
  SendMessage(RichEdit.Handle,WM_CUT,0,0);
end;

//拷贝------------------------------------------------------------------
procedure TSrmForm.CopyMenuItemClick(Sender: TObject);
begin
  SendMessage(RichEdit.Handle,WM_COPY,0,0);
end;

//粘贴----------------------------------------------------------------
procedure TSrmForm.PasteMenuItemClick(Sender: TObject);
begin
  SendMessage(RichEdit.Handle,WM_PASTE,0,0);
end;

//全选---------------------------------------------------------------
procedure TSrmForm.SelAllMenuItemClick(Sender: TObject);
begin
  RichEdit.SelectAll;
end;

//查找-----------------------------------------------------------------
procedure TSrmForm.FindMenuItemClick(Sender: TObject);
begin
  ReplaceDialog.ReplaceText:='';
  FindDialog.Execute;
end;

//查找下一个-------------------------------------------------------------
procedure TSrmForm.FindNextMenuItemClick(Sender: TObject);
begin
  if Length(ReplaceDialog.ReplaceText)<>0 then
  begin
    ReplaceDialog.Options:=ReplaceDialog.Options+[frReplace];
    ReplaceDialogReplace(Sender);
  end
  else if Length(FindDialog.FindText)<>0 then
  begin
    FindDialogFind(Sender);
  end
  else
    FindDialog.Execute;
end;

//替换------------------------------------------------------------------
procedure TSrmForm.ReplaceMenuItemClick(Sender: TObject);
begin
  ReplaceDialog.Execute;
end;

//删除空格---------------------------------------------------------------
procedure TSrmForm.DelSpaceMenuItemClick(Sender: TObject);
var
  i,Size:integer;
  OldBuf,NewBuf,TempOldBuf,TempNewBuf:pchar;
begin
  Size:=RichEdit.GetTextLen+2;
  GetMem(OldBuf,Size+1);
  GetMem(NewBuf,Size+1);
  TempOldBuf:=OldBuf;
  TempNewBuf:=NewBuf;
  RichEdit.GetTextBuf(OldBuf,Size);
  for i:=0 to Size do
  begin
    if TempOldBuf^=#32 then
    begin
      if ((pchar(integer(TempOldBuf-1))^>=#160) or
          (pchar(integer(TempOldBuf+1))^>=#160)) then
        inc(TempOldBuf)
      else
      begin
        TempNewBuf^:=TempOldBuf^;
        inc(TempNewBuf);
        inc(TempOldBuf);
      end;
    end
    else
    begin
      TempNewBuf^:=TempOldBuf^;
      inc(TempNewBuf);
      inc(TempOldBuf);
    end;
  end;
  TempNewBuf^:=#0;
  RichEdit.SetTextBuf(NewBuf);
  FreeMem(OldBuf);
  FreeMem(NewBuf);
end;


//****************************************************************
//工具栏显示---------------------------------------------------------
procedure TSrmForm.ToolsMenuItemClick(Sender: TObject);
begin
  ToolsMenuItem.Checked:=not ToolsMenuItem.Checked;
  CoolBar.Visible:=ToolsMenuItem.Checked;
end;
//状态栏显示---------------------------------------------------------
procedure TSrmForm.StatusMenuItemClick(Sender: TObject);
begin
  StatusMenuItem.Checked:=not StatusMenuItem.Checked;
  StatusBar.Visible:=StatusMenuItem.Checked;
end;
//视图栏显示---------------------------------------------------------
procedure TSrmForm.TitleMenuItemClick(Sender: TObject);
begin
  TitleMenuItem.Checked:=not TitleMenuItem.Checked;
  LeftPanelToolButton.Down:=TitleMenuItem.Checked;
  Splitter.Visible:=TitleMenuItem.Checked;
  LeftPanel.Visible:=TitleMenuItem.Checked;
end;
//只读控制-----------------------------------------------------------
procedure TSrmForm.ReadOnlyMenuItemClick(Sender: TObject);
begin
  ReadOnlyMenuItem.Checked:=not ReadOnlymenuItem.Checked;
  ReadOnlyToolButton.Down:=ReadOnlymenuItem.Checked;
  RichEdit.ReadOnly:=ReadOnlyMenuItem.checked;
end;
//放大字体------------------------------------------------------------
procedure TSrmForm.BigFontMenuItemClick(Sender: TObject);
begin
  RichEdit.Font.Size:=RichEdit.Font.Size+1;
end;
//缩小字体--------------------------------------------------------------
procedure TSrmForm.SmallFontMenuItemClick(Sender: TObject);
begin
  RichEdit.Font.Size:=RichEdit.Font.Size-1;
end;
//选项设置--------------------------------------------------------------
procedure TSrmForm.OptionsMenuItemClick(Sender: TObject);
begin
//
end;





//****************************************************************
//添加新节点----------------------------------------------------------
procedure TSrmForm.AddNodeMenuItemClick(Sender: TObject);
var
  ANode:TTreeNode;
  Id:integer;
begin
  ANode:=TreeView.Items.AddObjectFirst(TreeView.Selected,csNewDefaultTitle,
                                       pointer(-1));
  ANode.ImageIndex:=2;
  if ANode.Parent=nil then Id:=0 else Id:=integer(ANode.Parent.ItemId);
  SendMessage(TreeView.Handle,TVM_SORTCHILDREN,0,Id);
  TreeView.Selected:=ANode;
  with Srm.DataHead do
  begin
    DataType:=1;
    Author[0]:=#0;
    Password[0]:=#0;
    Num:=0;
  end;
  ANode.EditText;
  StatusBar.Refresh;
  DataChange:=true;
  IndexChange:=true;
end;
//添加新子节点--------------------------------------------------------
procedure TSrmForm.AddSubNodeMenuItemClick(Sender: TObject);
var
  ANode:TTreeNode;
  Id:integer;
begin
  ANode:=TreeView.Items.AddChildObjectFirst(TreeView.Selected,csNewDefaultTitle,
                                            pointer(-1));
  ANode.ImageIndex:=2;
  ANode.Parent.ImageIndex:=1;
  if ANode.Parent=nil then Id:=0 else Id:=integer(ANode.Parent.ItemId);
  SendMessage(TreeView.Handle,TVM_SORTCHILDREN,0,Id);
  TreeView.Selected:=ANode;
  with Srm.DataHead do