expertcad/SRC/SCSNormBase/U_GuideFileList.pas
2025-05-12 10:07:51 +03:00

783 lines
23 KiB
ObjectPascal
Raw Permalink Blame History

unit U_GuideFileList;
interface
uses
Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, IdGlobal,
Dialogs, ExtCtrls, RzPanel, RzButton, StdCtrls, RzEdit, Mask,
U_BaseCommon, U_BaseConstants, kbmMemTable, siComp, siLngLnk, pFIBDataSet,
Buttons, U_ProtectionCommon, XPMenu, ComCtrls, ToolWin, DB, cxStyles,
cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit,
cxDBData, cxMemo, cxCheckBox, cxCurrencyEdit, cxColorComboBox,
cxSpinEdit, cxTextEdit, cxGridLevel, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxClasses, cxControls,
cxGridCustomView, cxGrid, FIBQuery, pFIBQuery,
U_SCSComponent, U_SCSLists, U_Common, ActnList, ImgList, ShellApi, ComObj, Clipbrd, OleCtrls, OleCtnrs,
cxDBLookupComboBox, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator;
Const
wdPropertyTitle = $00000001;
wdPropertySubject = $00000002;
wdPropertyAuthor = $00000003;
wdPropertyKeywords = $00000004;
wdPropertyComments = $00000005;
wdPropertyTemplate = $00000006;
wdPropertyLastAuthor = $00000007;
wdPropertyRevision = $00000008;
wdPropertyAppName = $00000009;
wdPropertyTimeLastPrinted = $0000000A;
wdPropertyTimeCreated = $0000000B;
wdPropertyTimeLastSaved = $0000000C;
wdPropertyVBATotalEdit = $0000000D;
wdPropertyPages = $0000000E;
wdPropertyWords = $0000000F;
wdPropertyCharacters = $00000010;
wdPropertySecurity = $00000011;
wdPropertyCategory = $00000012;
wdPropertyFormat = $00000013;
wdPropertyManager = $00000014;
wdPropertyCompany = $00000015;
wdPropertyBytes = $00000016;
wdPropertyLines = $00000017;
wdPropertyParas = $00000018;
wdPropertySlides = $00000019;
wdPropertyNotes = $0000001A;
wdPropertyHiddenSlides = $0000001B;
wdPropertyMMClips = $0000001C;
wdPropertyHyperlinkBase = $0000001D;
wdPropertyCharsWSpaces = $0000001E;
wdDoNotSaveChanges = 0;
wdDialogFilePrint=88;
wdPageBreak = $00000007;
type
TF_GuideFileList = class(TForm)
gbOkCancel: TRzGroupBox;
btClose: TRzBitBtn;
lng_Forms: TsiLangLinked;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
mtFiles: TkbmMemTable;
dsrcFiles: TDataSource;
Grid_Files: TcxGrid;
GT_Files: TcxGridDBTableView;
GT_FilesName: TcxGridDBColumn;
GT_FilesDescription: TcxGridDBColumn;
GL_Files: TcxGridLevel;
ilToolBar: TImageList;
ActionList: TActionList;
Act_Print: TAction;
Act_PrintAll: TAction;
PrinterSetupDialog1: TPrinterSetupDialog;
Act_SaveToFile: TAction;
ToolButton4: TToolButton;
Act_SaveAllToFile: TAction;
meLog: TMemo;
GT_FilesFileExt: TcxGridDBColumn;
XPMenu1: TXPMenu;
procedure gbOkCancelResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Act_PrintExecute(Sender: TObject);
procedure Act_PrintAllExecute(Sender: TObject);
procedure Act_SaveToFileExecute(Sender: TObject);
procedure Act_SaveAllToFileExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
GForm: TForm;
FObjectID: Integer;
FFileContent: TMemoryStream;
FFileContentPacked: Boolean;
FFileExists: Boolean;
FType: Integer;
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FFileExtsWithMsg: TStringList;
procedure LoadFromFilesID(AFilesID: TIntList);
procedure LoadFromComponents(AComponents: TSCSComponents; aNetGuidList: TStringList = nil);
function PrintDoc(const AFileName, AFilePath: String; AStream: TMemoryStream=nil; AFileExt: String=''): Boolean;
function PrintDocOO(const AFilePath: String): Boolean;
procedure PrintFromID(AID: Integer);
procedure PrintAllPositions;
procedure PrintCurrPosition(AIsPrintingAll: Boolean);
procedure SaveCurrPositionToFile(const AFileName: String);
procedure SetControls;
procedure SetParamsToDialog(ADialog: TOpenDialog; const AFileExt: String);
public
NewID: Integer;
constructor Create(AOwner: TComponent; AForm: TForm);
destructor Destroy; override;
function Execute(AFType: Integer; AComponList: TSCSComponents; NetTypeGuidList: TStringList = nil): Boolean;
end;
function CreateFGuideFileList: TForm;
var
F_GuideFileList: TF_GuideFileList;
implementation
Uses U_Main, Unit_DM_SCS;
{$R *.dfm}
{ TF_MakeEditGuideFile }
constructor TF_GuideFileList.Create(AOwner: TComponent; AForm: TForm);
begin
GForm := AForm;
inherited Create(AOwner);
end;
destructor TF_GuideFileList.Destroy;
begin
inherited;
end;
//Tolik
// function TF_GuideFileList.Execute(AFType: Integer; AComponList: TSCSComponents): Boolean;
function TF_GuideFileList.Execute(AFType: Integer; AComponList: TSCSComponents; NetTypeGuidList: TStringList = nil): Boolean;
begin
Result := false;
FType := AFType;
try
SetControls;
if TList(NetTypeGuidList) = nil then
LoadFromComponents(AComponList)
else
LoadFromComponents(AComponList, NetTypeGuidList);
Act_PrintAll.Enabled := mtFiles.RecordCount > 0;
Act_SaveAllToFile.Enabled := mtFiles.RecordCount > 0;
gbOkCancelResize(gbOkCancel);
if ShowModal = mrOk then
begin
Result := true;
end;
except
on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_GuideFileList.Execute), E.Message);
end;
end;
procedure TF_GuideFileList.gbOkCancelResize(Sender: TObject);
begin
SetMiddleControlChilds(TControl(Sender), TControl(Self));
end;
procedure TF_GuideFileList.LoadFromFilesID(AFilesID: TIntList);
var
QSelect: TpFIBQuery;
i: Integer;
begin
mtFiles.Active := false;
mtFiles.Active := true;
mtFiles.DisableControls;
try
if AFilesID.Count > 0 then
begin
QSelect := TF_Main(GForm).FNormBase.DM.Query_Select;
SetSQLToFIBQuery(QSelect, GetSQLByParams(qtSelect, tnFiles, GetSQLOpeatorIN(fnID, '', AFilesID), nil, fnAll), false);
QSelect.ExecQuery;
LoadMTFromFIBQuery(mtFiles, QSelect);
QSelect.Close;
end;
finally
mtFiles.SortOn(fnFileName, []);
mtFiles.EnableControls;
end;
end;
procedure TF_GuideFileList.LoadFromComponents(AComponents: TSCSComponents; aNetGuidList: TStringList = nil);
var
ComponsGUIDList: TStringList;
FileIDList: TIntList;
FileID: Integer;
i: Integer;
SCSCompon: TSCSComponent;
QSelect: TpFIBQuery;
begin
ComponsGUIDList := TStringList.Create;
ComponsGUIDList.Sorted := true;
FileIDList := TIntList.Create;
QSelect := TF_Main(GForm).FNormBase.DM.Query_Select;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ID <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
SetSQLToFIBQuery(QSelect, GetSQLByParams(qtSelect, tnComponent, fnGUID+' = :'+fnGuid, nil, fnIDCompSpecification), false);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> GUID <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20> ID <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
for i := 0 to AComponents.Count - 1 do
begin
SCSCompon := AComponents[i];
if ((aNetGuidList = nil) or ((aNetGuidList <> nil) and (aNetGuidList.Indexof(SCScompon.GuidNetType) <> -1))) then
begin
if ComponsGUIDList.IndexOf(SCSCompon.GuidNB) = -1 then
begin
ComponsGUIDList.Add(SCSCompon.GuidNB);
QSelect.Close;
QSelect.Params[0].AsString := SCSCompon.GuidNB;
QSelect.ExecQuery;
if QSelect.RecordCount > 0 then
begin
FileID := QSelect.Fields[0].AsInteger;
if (FileID <> 0) and (FileIDList.IndexOf(FileID) = -1) then
FileIDList.Add(FileID);
end;
end;
end;
end;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
LoadFromFilesID(FileIDList);
FileIDList.Free;
ComponsGUIDList.Free;
end;
function TF_GuideFileList.PrintDoc(const AFileName, AFilePath: String; AStream: TMemoryStream=nil; AFileExt: String=''): Boolean;
var
FileName: String;
MsWord: OLEVariant;
Doc: OLEVariant;
SaveChanges : OLEVariant;
prntDlg: OLEVariant;
Created: Boolean;
OleCntnr: TOleContainer;
v: Variant;
//v: OLEVariant;
OLEStream: TMemoryStream;
FormHidden: TForm;
FileExt: String;
FilePath: String;
CanVerb: Boolean;
TmpDir: String;
DelTmpFile: Boolean;
begin
Result := false;
try
FilePath := '';
FileExt := AnsiLowerCase(AFileExt);
TmpDir := '';
DelTmpFile := false;
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
if (FileExt <> '.doc') or (Not IsWordInstalled) then
begin
FilePath := AFilePath;
if (FilePath = '') and (AStream <> nil) then
begin
//FilePath := GetPathToSCSTmpDir+'\file'+AFileExt;
TmpDir := CreateUniqueDirInSCSTmp;
FilePath := TmpDir +'\'+AFileName + AFileExt;
FilePath := GetNoExistsFileNameForCopy(FilePath);
AStream.Position := 0;
AStream.SaveToFile(FilePath);
DelTmpFile := true;
end;
end;
meLog.Lines.Clear;
//meLog.Lines.Add('File eXt '+AFileExt);
//if IsWordInstalled then
begin
Created := false;
if FilePath <> '' then
begin
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Word <20><><EFBFBD><EFBFBD><EFBFBD> MS Office
if IsWordInstalled and (FileExt = '.doc') then
begin
MsWord := CreateOleObject('Word.Application'); // meLog.Lines.Add('MsWord := CreateOleObject');
try
//MsWord.Documents.Add(AFilePath, EmptyParam);
MsWord.Documents.Open(FilePath); // meLog.Lines.Add('MsWord.Documents.Open(FilePath)');
//Doc := MsWord.Documents.Add;
//Doc.Range.InsertFile(FilePath);
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
//Doc.Range.InsertBreak(wdPageBreak);
//Doc.Bookmarks.Item('\EndOfDoc').Range.InsertFile('C:\Projects\<5C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>\Spain\Compon specification\DOCUMENTOS DE ESPECIFICACION\Cu01 STAR Cat6 Sin Apantallar\03_test Cu01_Patchpanels_Cat.6_SinApantallar.doc');
//Doc.BuiltInDocumentProperties[wdPropertyTitle].Value := 'Teeest...';
MsWord.Options.PrintBackground := False; // meLog.Lines.Add('MsWord.Options.PrintBackground := False');
MsWord.PrintOut; // meLog.Lines.Add('MsWord.PrintOut');
Result := true;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Doc := MsWord.Documents.Add; Doc.Range.InsertFile(FilePath);
//prntDlg := MsWord.Dialogs.item(wdDialogFilePrint);
//prntDlg.Show;
MsWord.Options.PrintBackground := True; // meLog.Lines.Add('MsWord.Options.PrintBackground := True');
finally
if not VarIsEmpty(MsWord) then
begin
SaveChanges := wdDoNotSaveChanges;
MsWord.Quit(SaveChanges);
MsWord := Unassigned;
end;
end;
end
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> Writer
else if (FileExt = '.doc') or (FileExt = '.odt') then
begin
if PrintDocOO(FilePath) then
Result := true;
end;
end
else if AStream <> nil then
begin
FormHidden := TForm.Create(Application);
FormHidden.Position := poDesktopCenter;
FormHidden.AlphaBlendValue := 0;
FormHidden.AlphaBlend := true;
FormHidden.Show; // meLog.Lines.Add('FormHidden.Show');
OleCntnr := TOleContainer.Create(nil);
OleCntnr.Parent := FormHidden;
OleCntnr.Align := alClient;
OLEStream := nil;
CanVerb := false;
if IsWordInstalled then
begin
OLEStream := TMemoryStream.Create;
AStream.Position := 0;
StreamToOLEStream(AStream, OLEStream); // meLog.Lines.Add('StreamToOLEStream(AStream, OLEStream)');
OleCntnr.LoadFromStream(OLEStream); // meLog.Lines.Add('OleCntnr.LoadFromStream(OLEStream)');
CanVerb := true;
end
else
if AFileExt <> '' then
begin
FilePath := GetPathToSCSTmpDir+'\file'+AFileExt;
FilePath := GetNoExistsFileNameForCopy(FilePath);
AStream.Position := 0;
AStream.SaveToFile(FilePath);
OleCntnr.CreateObjectFromFile(FilePath, false); // meLog.Lines.Add('OleCntnr.CreateObjectFromFile');
CanVerb := true;
end;
if CanVerb then
begin
OleCntnr.DoVerb(ovShow);
meLog.Lines.Add('OleCntnr.DoVerb(ovShow)');
if (AFileExt = '') or (AFileExt = '.doc') then
begin
v := OleCntnr.OleObject.Application.WordBasic; //meLog.Lines.Add('v := OleCntnr.OleObject.Application.WordBasic');
V.ToolsOptionsPrint(Background := 0); // meLog.Lines.Add('V.ToolsOptionsPrint(Background := 0)');
V.FilePrint; // meLog.Lines.Add('V.FilePrint');
Result := true;
V.ToolsOptionsPrint(Background := 1); // meLog.Lines.Add('V.ToolsOptionsPrint(Background := 1)');
end
else if AFileExt = '.odt' then
begin
//v := OleCntnr.OleObject; // meLog.Lines.Add('v := OleCntnr.OleObject');
//v.Print; // meLog.Lines.Add('v.Print');
// Result := true;
end;
end;
OleCntnr.Free;
FormHidden.Free;
if OLEStream <> nil then
OLEStream.Free;
end;
//ShellExecute(Handle, 'print', PChar(FilePath), nil, nil, SW_HIDE);
end;
if DelTmpFile then
begin
DeleteFile(FilePath);
RemoveDir(TmpDir);
end;
except
on E: Exception do AddExceptionToLogEx('TF_GuideFileList.PrintDoc', E.Message);
end;
end;
function TF_GuideFileList.PrintDocOO(const AFilePath: String): Boolean;
//const
// Bounds:array[1..2] of integer = (0,0);
var
OO: Variant;
Document: Variant;
VariantArray: Variant;
Desktop: Variant;
Created: Boolean;
FileUrl: String;
function OOMakePropertyValue(PropertyName, PropertyValue:Variant):variant;
var
Structure: variant;
begin
Structure := OO.Bridge_GetStruct('com.sun.star.beans.PropertyValue');
Structure.Name := PropertyName;
Structure.Value := PropertyValue;
Result := Structure;
end;
begin
Result := false;
if IsOOInstalled then
begin
OO := CreateOleObject('com.sun.star.ServiceManager');
try
Desktop := OO.CreateInstance('com.sun.star.frame.Desktop');
//VariantArray := VarArrayCreate([0, 1], varVariant);
//VariantArray[0] := OOMakePropertyValue('FilterName', 'MS Word 97');
//VariantArray[1] := OOMakePropertyValue('Hidden', True);
VariantArray := VarArrayCreate([0, 1], varVariant);
VariantArray[0] := OOMakePropertyValue('Hidden', True);
//FileUrl := ReplaceTextInStr('\', '/', ShortToLongFileName(AFilePath), false, nil);
//FileUrl := 'file:///'+ ReplaceTextInStr(' ', '%20', FileUrl, false, nil);
FileUrl := 'file:///'+ ReplaceTextInStr('\', '/', AFilePath, false, nil);
Document := Desktop.LoadComponentFromURL(FileUrl, '_blank', 0, VariantArray);
//Document := OO.OpenDocument(AFilePath,[oomReadOnly],ommNever);
Created := not (VarIsEmpty(Document) or VarIsNull(Document));
if Created then
begin
//VariantArray := VarArrayCreate(Bounds, varVariant);
VariantArray := VarArrayCreate([0, 1], varVariant);
VariantArray[0]:= OOMakePropertyValue('CopyCount', 1);
VariantArray[1]:= OOMakePropertyValue('Wait', true);
Document.print(VariantArray);
Result := true;
Document.Close(True);
end;
Document := Unassigned;
Desktop := Unassigned;
finally
OO := Unassigned;
end;
end;
end;
procedure TF_GuideFileList.PrintFromID(AID: Integer);
var
//BookMarkStr: String;
BookMarkStr: TBookMark;
begin
//BookMarkStr := mtFiles.Bookmark;
BookMarkStr := mtFiles.GetBookmark;
mtFiles.DisableControls;
try
if mtFiles.Locate(fnID, AID, []) then
begin
PrintCurrPosition(false);
end;
finally
mtFiles.EnableControls;
//mtFiles.Bookmark := BookMarkStr;
mtFiles.GotoBookmark(BookMarkStr);
mtFiles.FreeBookmark(BookMarkStr);
end;
end;
procedure TF_GuideFileList.PrintAllPositions;
var
//BookMarkStr: String;
BookMarkStr: TBookMark;
begin
FFileExtsWithMsg.Clear;
//BookMarkStr := mtFiles.Bookmark;
BookMarkStr := mtFiles.GetBookmark;
mtFiles.DisableControls;
BeginProgress('', mtFiles.RecordCount);
try
mtFiles.First;
while Not mtFiles.Eof do
begin
PrintCurrPosition(true);
mtFiles.Next;
StepProgress;
Application.ProcessMessages;
end;
finally
EndProgress;
mtFiles.EnableControls;
//mtFiles.Bookmark := BookMarkStr;
mtFiles.GotoBookmark(BookMarkStr);
mtFiles.FreeBookmark(BookMarkStr);
end;
end;
procedure TF_GuideFileList.PrintCurrPosition(AIsPrintingAll: Boolean);
var
FileExt: String;
FileName: String;
FilePath: String;
Stream: TMemoryStream;
UnpackedStream: TMemoryStream;
Msg: String;
begin
if mtFiles.RecNo > 0 then
begin
FileName := mtFiles.FieldByName(fnFileName).AsString;
FileExt := mtFiles.FieldByName(fnFileExt).AsString;
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
if FFileExtsWithMsg.IndexOf(FileExt) = -1 then
begin
FilePath := GetPathToSCSTmpDir+'\file'+FileExt;
FilePath := GetNoExistsFileNameForCopy(FilePath);
Stream := TMemoryStream.Create;
UnpackedStream := TMemoryStream.Create;
TBLobField(mtFiles.FieldByName(fnContent)).SaveToStream(Stream);
UnPakStream(Stream, UnpackedStream);
//if Not IsWordInstalled then
// begin
// UnPackedStream.SaveToFile(FilePath);
// UnPackedStream.Position := 0;
// PrintDoc(FileName, FilePath);
// DeleteFile(FilePath);
//
// UnPackedStream.Clear;
// //UnPackedStream.LoadFromFile('C:\Projects\<5C><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>\Spain\Compon specification\DOCUMENTOS DE ESPECIFICACION\Cu01 STAR Cat6 Sin Apantallar\03_test Cu01_Patchpanels_Cat.6_SinApantallar.doc');
// end
// else
// PrintDoc(FileName, '', UnPackedStream);
if Not PrintDoc(FileName, '', UnPackedStream, FileExt) then
begin
// <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if FFileExtsWithMsg.IndexOf(FileExt) = -1 then
begin
if GIsProgress then
PauseProgress(true);
try
Msg := cGuideFileList_Msg3_1 + FileName+FileExt;
if AIsPrintingAll then
Msg := Msg + snNextRow + cGuideFileList_Msg3_2;
MessageInfo(Msg);
finally
if GIsProgress then
PauseProgress(false);
end;
FFileExtsWithMsg.Add(FileExt);
end;
end;
UnpackedStream.Free;
Stream.Free;
end;
end;
end;
procedure TF_GuideFileList.SaveCurrPositionToFile(const AFileName: String);
var
FileExt: String;
FileName: String;
FilePath: String;
Stream: TMemoryStream;
UnpackedStream: TMemoryStream;
begin
if mtFiles.RecNo > 0 then
begin
if FileExists(AFileName) then
begin
if GIsProgress then
PauseProgress(true);
try
if MessageQuastYN(AFileName+' '+cNowExists+'. '+cQuastReplaceIt) = IDYES then
DeleteFile(AFileName)
else
Exit; ///// EXIT /////
finally
if GIsProgress then
PauseProgress(false);
end;
end;
Stream := TMemoryStream.Create;
UnpackedStream := TMemoryStream.Create;
TBLobField(mtFiles.FieldByName(fnContent)).SaveToStream(Stream);
UnPakStream(Stream, UnpackedStream);
UnPackedStream.Position := 0;
UnPackedStream.SaveToFile(AFileName);
UnpackedStream.Free;
Stream.Free;
end;
end;
procedure TF_GuideFileList.SetControls;
begin
case FType of
gftCompSpecification:
Caption := cGuideFileList_Msg1_1;
else
Caption := '';
end;
end;
procedure TF_GuideFileList.SetParamsToDialog(ADialog: TOpenDialog; const AFileExt: String);
begin
case FType of
gftCompSpecification:
begin
//ADialog.DefaultExt := '*.'+enDoc;
//ADialog.Filter := GetDialogFilter(cexdDoc, enDoc);
ADialog.DefaultExt := '*'+AFileExt;
ADialog.Filter := GetDialogFilter(GetExtensionDescription(AFileExt), AFileExt);
end;
end;
ADialog.InitialDir := '';
ADialog.FileName := '';
ADialog.Options := ADialog.Options - [ofNoChangeDir];
end;
function CreateFGuideFileList: TForm;
begin
Result := nil;
if F_GuideFileList = nil then
F_GuideFileList := TF_GuideFileList.Create(Application, F_NormBase);
Result := F_GuideFileList;
end;
procedure TF_GuideFileList.FormCreate(Sender: TObject);
begin
ActionCaptionsToHints(ActionList);
mtFiles.FieldDefs.Add(fnID, ftInteger);
mtFiles.FieldDefs.Add(fnFileName, ftString, 255);
mtFiles.FieldDefs.Add(fnFileExt, ftString, 255);
mtFiles.FieldDefs.Add(fnDescription, ftBlob, 255);
mtFiles.FieldDefs.Add(fnContent, ftBlob);
mtFiles.FieldDefs.Add(fnFType, ftInteger);
FFileExtsWithMsg := TStringList.Create;
end;
procedure TF_GuideFileList.Act_PrintExecute(Sender: TObject);
begin
//
if mtFiles.RecNo > 0 then
begin
//PrintFromID(mtFiles.FieldByName(fnID).AsInteger);
BeginProgress;
try
FFileExtsWithMsg.Clear;
PrintCurrPosition(false);
finally
EndProgress;
end;
end;
end;
procedure TF_GuideFileList.Act_PrintAllExecute(Sender: TObject);
begin
if MessageQuastYN(cGuideFileList_Msg2_1) = IDYES then
begin
PrintAllPositions;
end;
end;
procedure TF_GuideFileList.Act_SaveToFileExecute(Sender: TObject);
var
Dialog: TSaveDialog;
FileExt: String;
FileName: String;
begin
if mtFiles.RecNo > 0 then
begin
FileName := mtFiles.FieldByName(fnFileName).AsString;
FileExt := mtFiles.FieldByName(fnFileExt).AsString;
Dialog := TSaveDialog.Create(Self);
Dialog.Title := cSavingToFile;
SetParamsToDialog(Dialog, FileExt);
Dialog.FileName := FileName + FileExt;
Dialog.Options := Dialog.Options + [ofOverwritePrompt];
if Dialog.Execute then
begin
Application.ProcessMessages;
if FileExists(Dialog.FileName) then
DeleteFile(Dialog.FileName);
SaveCurrPositionToFile(Dialog.FileName);
end;
FreeAndNil(Dialog);
end;
end;
procedure TF_GuideFileList.Act_SaveAllToFileExecute(Sender: TObject);
var
DirName: String;
//BookMarkStr: String;
BookMarkStr: TBookMark;
FileExt: String;
FileName: String;
begin
DirName := BrowseDialog(cBaseOptions_Msg5, '');
if DirName <> '' then
begin
//BookMarkStr := mtFiles.Bookmark;
BookMarkStr := mtFiles.GetBookmark;
mtFiles.DisableControls;
BeginProgress('', mtFiles.RecordCount);
try
mtFiles.First;
while Not mtFiles.Eof do
begin
FileName := mtFiles.FieldByName(fnFileName).AsString;
FileExt := mtFiles.FieldByName(fnFileExt).AsString;
SaveCurrPositionToFile(DirName +'\'+ FileName+FileExt);
mtFiles.Next;
StepProgress;
Application.ProcessMessages;
end;
if mtFiles.RecNo > 0 then
ShellExecute(Handle, nil, PChar(DirName), nil, nil, SW_SHOW);
finally
EndProgress;
mtFiles.EnableControls;
//mtFiles.Bookmark := BookMarkStr;
mtFiles.GotoBookmark(BookMarkStr);
mtFiles.FreeBookmark(BookMarkStr);
end;
end;
end;
procedure TF_GuideFileList.FormDestroy(Sender: TObject);
begin
FFileExtsWithMsg.Free;
end;
end.