Reading Word-file (*.dot) from program resources - delphi

Have a set of Word-templates (files *.dot) and a little program, which create new files base on that templates. It's works fine, but the goal is to make all in one exe-file.
I see the solution is to move templates files into program resources. But I don't know, how then I will read them from resources. Tell me, please, how to do this.
Maybe you can advise me another solution.
Now, my code is:
procedure TfmMain.CreateDocument0;
var
TempleateFileName: string;
WordApp, Document: OleVariant;
procedure FillBookmark(BookmarkName, bText: string);
var
Range: OleVariant;
begin
if Document.Bookmarks.Exists(BookmarkName) then
begin
Range := Document.Bookmarks.Item(BookmarkName).Range;
Range.Text := bText;
end;
end;
begin
TempleateFileName := ExtractFilePath(Application.ExeName)+'Templates\0.dot';
try
WordApp := GetActiveOleObject('Word.Application');
except
try
WordApp := CreateOleObject('Word.Application');
except
on E: Exception do
begin
MessageBox(Self.Handle, PChar(E.Message), PChar(fmMain.Caption), MB_OK+MB_ICONERROR);
Exit;
end;
end;
end;
try
Document := WordApp.Documents.Add(TempleateFileName, False);
FillBookmark('ObjectType', edt0ObjectType.Text);
...
WordApp.Visible := True;
WordApp.Activate;
finally
WordApp := Unassigned;
end;
end;
That is, I should change this line:
Document := WordApp.Documents.Add(TempleateFileName, False);
Read not from file, but from program resource.

Word cannot open documents from memory. Not only does it not have such a feature, you must also bear in mind that Word executes in a separate process. It cannot see the memory in your process, even if it were able to open documents from memory.
If you do put the documents into linked resources then you will need to extract them to file before asking Word to open them.

Related

Moving to recycle bin from elevated process

I am using SHFileOperationW function with FO_DELETE parameter to move a file to recycle bin (if recycle bin is not disabled).
The problem is when I log as non-admin user and run my application as admin. The files are moved to admin's recycle bin.
Is it possible to make it so the files are moved to the currenly logged non-admin user's recycle bin?
My idea was to run separate non-elevated process and move it to recycle bin from there. But I am not sure if a better solution exists. I tried to find answer on internet, but did not succeed.
I would propose the following routine - tested on Delphi XE 10.
function File2Trash(const FileName: string): boolean;
var
fos: TSHFileOpStruct;
begin
FillChar(fos, SizeOf(fos), 0);
with fos do
begin
wFunc := FO_DELETE;
pFrom := PChar(ExpandFileName(FileName)+#0#0);
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT or FOF_NOERRORUI;
end;
Result := (0 = ShFileOperation(fos));
end;
Some details are important:
no relative path should be used, existing path should be expanded to
full one;
adding #0#0 to the end of file name is the must;
to keep this operation silent I would propose to use one more flag
FOF_NOERRORUI.
When I needed to use this routine, I used the following commands.
I hope it is useful.
Tests with Delphi 2010 and Windows 8.
procedure TForm2.Button1Click(Sender: TObject);
var
vMsg : string;
begin
// If want permanently delete
//deletefile(edit1.text);
SendFileToTrash(edit1.Text, vMsg);
if (vMsg = '') then
begin
ShowMessage('File sent to the trash.');
end else begin
ShowMessage(vMsg);
end;
end;
procedure TForm2.SendFileToTrash(const aFileName: TFileName; var MsgError: string);
var
Op: TSHFileOpStruct;
begin
{Very importante
Include in Uses SysUtils and ShellAPI;
}
MsgError := '';
if not (FileExists(aFileName)) then
begin
MsgError := 'File not found.';
Exit;
end;
FillChar(Op, SizeOf(Op), 0);
Op.wFunc := FO_DELETE;
Op.pFrom := PChar(aFileName+#0);
Op.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
if (ShFileOperation(Op) <> 0) then
begin
MsgError := 'Could not send the file to the trash.';
end;
end;

TDirectoryWatch not firing first time

I have a small application that is used to process some files made in another program.
I use an older component by Angus Johnson called TDirectoryWatch
On my FormCreate I have the following code
DirectoryWatch := TDirectoryWatch.Create(self);
DirectoryWatch.OnChange := FileAction;
DirectoryWatch.Directory := Folders.Path(dirInput);
DirectoryWatch.Active := True;
If the program is started and there is put a new file in the directory everything fires and runs OK.
But if there is a file in the directory when the program is started nothing happens even if I make a call to FileAction(nil);
FileAction is the name of the procedure that handles the files
I have a call to FileAction from a popupmenu and that handles the files in the directory
So my question is: how to make sure that existing files are handled at program start?
Or is there a better way to handle this problem.
Added code for FileAction
procedure TfrmMain.FileAction(Sender: TObject);
var
MailFile: string;
MailInfo: TMailInfo;
ListAttachments: TstringList;
i: integer;
MailBody: string;
begin
for MailFile in TDirectory.GetFiles(Folders.Path(dirInput), CheckType) do
begin
if FileExists(MailFile) then
begin
MailInfo := TMailInfo.Create(MailFile);
try
if FileProcessing = False then
begin
Logfile.Event('Behandler fil: ' + MailFile);
FileProcessing := True;
MailBody := '';
Settings.Load;
MailInfo.Load;
Settings.Mail.Signature := '';
Settings.Mail.Subject := MailInfo.Subject;
ListAttachments := TStringList.Create;
ListAttachments.Clear;
for i := 1 to MaxEntries do
begin
if (MailInfo.Attachment[i] <> '') and (FileExists(MailInfo.Attachment[i])) then
ListAttachments.Add(MailInfo.Attachment[i]);
end;
for i := 1 to MaxEntries do
begin
MailBody := MailBody + MailInfo.MailBody[i];
end;
try
if MailBody <> '' then
begin
if MailInfo.SenderBcc then
Mailing.Send(MailInfo.SenderMail, MailInfo.Recipient, MailInfo.SenderMail, MailInfo.Subject, MailBody, ListAttachments, True)
else
Mailing.Send(MailInfo.SenderMail, MailInfo.Recipient, MailInfo.Subject, MailBody, ListAttachments, True);
end;
finally
ListAttachments.Free;
end;
FileProcessing := False;
DeleteFile(MailFile);
end;
finally
MailInfo.Free;
end;
end;
end;
end;
The component doesn't notify about changes when your program starts up because at the time your program starts, there haven't been any changes yet.
Your policy appears to be that at the time your program starts up, all existing files are to be considered "new" or "newly changed," so your approach of manually calling the change-notification handler is correct.
The only thing the component does when it detects a change is to call the change-notification handler. If you explicitly call that function, and yet you still observe that "nothing happens," then there are more deep-seated problems in your program that you need to debug; it's not an issue with the component or with the basic approach described here.

Load Log.txt From other apps to Memo - Delphi7

I am trying to record the session log from other applications (Proxifier) to a Memo.
I've tried using the command :
procedure TForm1.TimerTimer(Sender: TObject);
begin
Memo1.Lines.LoadFromFile('C:\PMASSH\Proxyfier\Profiles\Log.txt');
end;
but at certain times I get an error
Can you help my problem above ? I would really appreciate of all the answers.
Thanks
The other program has opened the file with a sharing mode that does not allow other processes to read it. Typically this happens when the other application is writing to the file.
There's not a whole lot you can do about this. This is perfectly normal behaviour, and is to be expected. You can try detecting the error, waiting for a short period of time, and re-trying.
Since you are already running this on a timer, the re-try will just happen. So perhaps you just need to suppress those exceptions:
procedure TForm1.TimerTimer(Sender: TObject);
begin
try
Memo1.Lines.LoadFromFile(...);
except
on EFOpenError do
; //swallow this error
end;
end;
Note that detecting EFOpenError is perhaps a little crude. Perhaps there are other failure modes that lead to that error. However, as a first pass, the code above is a decent start.
David's answer is correct. I just want to clarify why this is happening.
The answer lies in the code:
procedure TStrings.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
as you can see, the file is accessed for sharing but no writing is allowed.
you can solve this by creating the filestream yourself:
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
and then use the Lines.LoadFromStream() method to load the contents into the memo
Please note that the problem may subsist in cases where the other application has opened the file in exclusive mode (i.e. no sharing), so proper Exception management like in David's answer is still needed.
You can try your luck with ReadFile WinAPI. On a shared read open mode, you'll be able to sneak and read the contents of the file at last file buffer flush. If that another application (Proxifier) opened the file with CreateFile WinAPI with FILE_SHARE_READ share mode then you'll be able to open it for reading, as long as you use ReadFile API. Standart LoadFromFile method won't work here if it still was opened for share, and you'll get the same 'lock' error.
But here's the catch.. You'll have to deal with buffers, sizes and handles... You'll have to assing a handle to file for reading, get the file size with that handle, set an array with that size, do read to that array and assign, add (whatever) that array to the memo.. Pure usage of WinAPI. Some job for a simple task...
Here is a basic example of how to deal with files with WinAPI:
The key assumption of that other application's file open process:
var
Form1: TForm1;
logfile: Textfile;
h: THandle;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
// AssignFile(logfile, 'c:\deneme.txt');
// Rewrite(logfile);
h := CreateFile('C:\deneme.txt', GENERIC_WRITE, FILE_SHARE_READ, nil,
CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
Timer1.enabled := true;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.enabled := false;
// CloseFile(logfile);
CloseHandle(h);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
str: AnsiString;
p: pointer;
buf: array of ansichar;
written: cardinal;
begin
// Writeln(logfile, 'denemeStr');
str := 'denemeStr' + #13#10;
p := pansichar(str);
SetLength(buf, length(str));
move(p^, buf[0], length(str));
WriteFile(h, buf[0], length(buf), written, nil);
FlushFileBuffers(h);
end;
And if it's been shared for reading, this is how you can read from it:
procedure TForm1.Button1Click(Sender: TObject);
var
h: THandle;
buf: array of ansichar;
size, read: cardinal;
begin
Memo1.Lines.Clear;
// Memo1.Lines.LoadFromFile('c:\deneme.txt');
h := CreateFile('C:\deneme.txt', GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
size := GetFileSize(h, nil);
SetLength(buf, size);
ReadFile(h, buf[0], size, read, nil);
CloseHandle(h);
Memo1.Lines.Add(pansichar(buf));
end;
Hope this'd help...
procedure TForm1.TimerTimer(Sender: TObject);
begin
Memo1.Lines.LoadFromFile('C:\PMASSH\Proxyfier\Profiles\Log.txt');//// read file path error if file notfound
// if trying to record
Memo1.Lines.SaveToFile(Path...);
end;

Delphi: deny access to file for other processes

How can I deny access (only to write) to a file for other processes? I will read\write a file all time.
I use
FileOpen('c:\1.txt', fmOpenReadWrite or fmShareDenyWrite)
but after (starting to load the file to StringList) I get error
Cannot open file C:\1.txt. The process cannot access the file because it is being used by other process."
Only I open the file.
Here, the error message is actually slightly misleading. The reason you can't load into the stringlist is because you already opened the file in read/write.
if you check the implementation of TStrings.LoadfromFile:
procedure TStrings.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
You see that it tries to open the file with a "DenyWrite" condition, but you already opened the file in write mode. That is the reason why it fails.
You can work around that by using LoadFromStream instead.
procedure TForm1.Button1Click(Sender: TObject);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
try
Stringlist.LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
Note that you will need to use fmShareDenyNone for this to work in that situation. Then again, you could probably reuse the Read/Write handle you got from your OpenFile, probably do something like this:
procedure TForm1.Button1Click(Sender: TObject);
var
Stream: TStream;
iPosition : Int64;
begin
Stream := THandleStream.Create(FHandle); //FHandle is the read/write handle returned by OpenFile
try
iPosition := Stream.Position;
Stream.Seek(0, soFromBeginning);
Stringlist.LoadFromStream(Stream);
Stream.Position := iPosition;
//Restore stream position.
finally
Stream.Free;
end;
end;
But be advised that these approach might have a few "gotchas" I'm unaware of.

Test if disk has write access

I need to know if my program can write files to the disk (HDD, floppy, flash, CD) from where it is running.
I have tried something like:
{$I-}
Rewrite(myFile);
{$I+}
Result:= (IOResult = 0);
The problem is that if the disk is read-only, Windows gives me an error message telling me that
"appName.exe - Write Protect Error The disk cannot be written to because it is write protected. Please remove the write protection from the volume
USB_BOOT in drive D:. Cancel TryAgain Continue"
How can I test for write access without raising any error/warning messages?
Thanks.
Edit:
Ok. The "bug" has nothing to do with the above mentioned piece of code. I only thought that it appears there. I move the code to the read-only disk and ran it from there. The bug appears in a function called "CreateShortcutEx", on this line:
MyPFile.Save(PWChar(WFileName),False);
MyPFile is declared like this:
var
MyObject : IUnknown;
MySLink : IShellLink;
MyPFile : IPersistFile;
Directory : String;
WFileName : WideString;
MyReg : TRegIniFile;
begin
MyObject := CreateComObject(CLSID_ShellLink);
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
.....
end;
So, why is MyPFile trying to write to the application's drive (the one that is read-only) if the WFileName parameter is "C:\documents and settings\bla bla" ?
Call the Windows API SetErrorMode() function to disable the error message box.
Edit:
I just tried, and this:
procedure TForm1.Button1Click(Sender: TObject);
var
Str: TStream;
OldMode: Cardinal;
begin
OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
try
Str := TFileStream.Create('z:\foo.txt', fmOpenReadWrite);
try
finally
Str.Free;
end;
except end;
finally
SetErrorMode(OldMode);
end;
end;
works as expected.
Not really pretty but this seems to work for me.
function CanWrite(drive: string): boolean;
var
OldMode: Cardinal;
begin
OldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
with TStringList.Create do
try
SaveToFile(drive + ':\file.txt');
result := true;
try
deletefile(drive + ':\file.txt');
except
end;
except
result := false;
end;
finally
SetErrorMode(OldMode);
end;
end;
Call to it with
if CanWrite('g') = true then
begin
showmessage('Can Write');
end
else
begin
showmessage('Can not write');
end;
What happens when you put your code inside an try/except?
Also, you can try (something like) this:
function CanWrite: boolean;
begin
result := true;
with TStringList.Create do
try
SaveToFile('file.txt');
except
result := false;
finally
Free;
end;
end;
Sorry, but I don't code in Delphi anymore and I don't have Delphi installed anywhere.
There exist a small freeware "Drive ready?" utility (dready.com) written by Horst Schaeffer that also can check write access. I have not tested it but as far as I can see this could be used as a solution; call it for instance as "DREADY C: /W" and check the return value.

Resources