This question already has an answer here:
Get filename from full path in Pascal
(1 answer)
Closed 6 years ago.
I'm still a beginner using Delphi 7
When I load a VPN config file using TOpenDialog, I put the FileName in a TLabel, but its Caption displays the complete file path, eg:
D:\ConfigVPN\sample.ovpn
How can I display just the file name only?
sample.ovpn
When my application is closed and reopened, how can the Caption be fixed to sample.ovpn?
This is my code:
procedure TForm1.loadClick(Sender: TObject);
begin
if OpenDialog.Execute then begin
config:=OpenDialog.FileName;
Label.Caption:=config;
uhuy;
end;
end;
You can use the ExtractFileName() function in the SysUtils unit:
uses
..., SysUtils;
procedure TForm1.FormCreate(Sender: TObject);
begin
config := ...;
Label.Caption := ExtractFileName(config);
end;
procedure TForm1.loadClick(Sender: TObject);
begin
if OpenDialog.Execute then begin
config := OpenDialog.FileName;
Label.Caption := ExtractFileName(config);
uhuy;
end;
end;
Related
Similar Delphi code (multiple emails with RTF body sending via Outlook-Redemption) below has been working well without any problems for years.
Recently when our company changed to Outlook365 (Office365) we had to buy the newest Redemption (version 5.21) since the code stopped working: MAPI_E_CALL_FAILED. This issue is solved by the new version.
However foreign colleagues keep reporting me MAPI_E_OBJECT_CHANGED error by around every 5th or 6th emails. They use Exchange server 2010. We use Exchange 2013 and have no problem.
I do not know if it is related the version of Exchange server.? or RTF body? What else could be the reason?
Error message pic
var
Form1: TForm1;
ovSafeMailItem, ovOutlookSession : OleVariant;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ovSafeMailItem := CreateOLEObject('Redemption.SafeMailItem');
ovOutlookSession := CreateOLEObject('Redemption.RDOSession');
if FileExists('defaultBody.rtf') then
reBody.Lines.loadfromfile('defaultBody.rtf');
end;
function GetRTF(reBody: TJvRichedit): string;
var strStream: TStringStream;
begin
strStream := TStringStream.Create('') ;
try
reBody.PlainText := False;
reBody.Lines.SaveToStream(strStream) ;
Result := strStream.DataString;
finally
strStream.Free;
end;
end;
procedure TForm1.SendEmail;
var ovItem : OleVariant;
begin
ovOutlookSession.Logon;
try
try
ovItem:=ovOutlookSession.GetDefaultFolder(olFolderInbox).Items.Add('IPM.Note');
ovSafeMailItem.Item:=ovItem;
ovSafeMailItem.Recipients.Add(edtAddr1.text);
ovSafeMailItem.Recipients.Add(edtAddr2.text);
ovSafeMailItem.Recipients.ResolveAll;
ovSafeMailItem.Subject:=edtSubject.Text;
ovSafeMailItem.RTFBody:=GetRTF(reBody);
ovSafeMailItem.Send;
except
on E: Exception do
begin
MessageDlg('Cannot send email!'+#13+#13+'Error message: '#13+E.message,mtError,[mbOK],0);
end;
end
finally
ovOutlookSession.Logoff;
end;
end;
procedure TForm1.SendEmail2;
var ovItem : OleVariant;
begin
ovOutlookSession.Logon;
try
try
ovItem:=ovOutlookSession.GetDefaultFolder(olFolderInbox).Items.Add('IPM.Note');
ovItem.Recipients.Add(edtAddr1.text);
ovItem.Recipients.Add(edtAddr2.text);
ovItem.Recipients.ResolveAll;
ovItem.Subject:=edtSubject.Text;
ovItem.RTFBody:=GetRTF(reBody);
ovItem.Send;
except
on E: Exception do
begin
MessageDlg('Cannot send email!'+#13+#13+'Error message: '#13+E.message,mtError,[mbOK],0);
end;
end
finally
ovOutlookSession.Logoff;
end;
end;
procedure TForm1.btnSendClick(Sender: TObject);
begin
SendEmail2;
end;
I've got a project at schools which requires to write datas from a .txt file to a "memobox" in Lazarus freepascal.
There are datas in order like this.
Budapest tomato 23
Dublin tv 45
Rosslare projector 43
etc.
I have to read these datas from a .txt file and then write them into a memobox in Lazarus freepascal.
If I am not mistaken I have already copyed the datas from the .txt file but I have no idea how to write them.
I've already written this code:
type
cityname:integer;
product:string;
quantity:integer;
var
Form1: TForm1;
ceg:array[1..5] of rektip;
db:integer;
implementation
procedure TForm1.Button1Click(Sender: TObject);
var f:textfile; i:integer; a:char;
begin
assignfile(f,'termek.txt');
reset(f);
readln(f,db);
While not eof(f) do
begin
readln(f,ceg[i].varosnev,a,ceg[i].termek,a,ceg[i].darabszam);
end;
db:=1;
closefile(f);
end;
procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
For i:=1 to db do
Memo1.lines.add(ceg[i].varosnev,ceg[i].termek,IntToStr(ceg[i].darabszam));
end;
end;
I would like to know how to fix it.
The code you posted is incomplete, so I assume:
type
rektip = record
varosnev: string;
termek: string;
darabszam: Integer;
end;
There is a lot wrong with your approach:
readln(f,db);
While not eof(f) do
begin
readln(f,ceg[i].varosnev,a,ceg[i].termek,a,ceg[i].darabszam);
end;
db:=1;
closefile(f);
end;
You are not initializing nor updating i, so you are reading all data into the same record, and you don't even know which one (i could be 100 and you'd be writing the data to somewhere unknown -- there is no ceg[100]). That results in undefined behaviour (and that can be a crash too).
Do something like:
var
ceg: array of rektip;
...
begin
AssignFile(f, 'termek.txt');
Reset(f);
Readln(f, db);
if db = 0 then
Exit;
SetLength(ceg, db);
i := 0;
while not eof(f) do
begin
Readln(f, ceg[i].varosnev, ceg[i].termek, ceg[i].darabszam);
Inc(i);
if i > High(ceg) then
Break;
end;
SetLength(ceg, i); // remove any empty slots.
CloseFile(f);
end;
Now you can put them into the TMemo:
for i := Low(ceg) to High(ceg) do
begin
Memo1.Lines.Add(Format('%s %s %d', [ceg[i].varosnev, ceg[i].termek, ceg[i].darabszam]));
end;
Note that the code above, reading from the file, assumes the file looks like:
3
Budapest tomato 23
Dublin tv 45
Rosslare projector 43
i.e. each "record" is on a line of its own and the first line contains the number of records.
I am having problems with adding text I have entered into a tedit, into an record.
Here is the code i currently have:
procedure TForm7.AddNewQuestionClick(Sender: TObject);
var
w: integer;
QuestDesc, QuestAnsr: string;
begin
NewQuestID.text:=(GetNextQuestionID); //Increments QuestionID part of record
w:=Length(TQuestions);
SetLength(TQuestions, w+1);
QuestDesc:= NewQuestDesc.text;
QuestAnsr:= NewQuestAns.text;
TQuestionArray[w+1].Question:= QuestDesc; // Error on this line (No default property available)
TQuestionArray[w+1].Answer:= QuestAnsr;
end;
Here is the record I am trying to add to:
TQuestion = record
public
QuestionID: integer;
Question: shortstring;
Answer: shortstring;
procedure InitQuestion(anID:integer; aQ, anA:shortstring);
end;
TQuestionArray = array of TQuestion;
Any help solving this problem would be greatly appreciated.
You're missing a few things. You've declared a procedure to help initialize a new question - you should be using it.
This should get you going:
type
TQuestion = record
QuestionID: integer;
Question: ShortString;
Answer: ShortString;
procedure InitQuestion(anID: Integer; aQ, aAns: ShortString);
end;
TQuestionArray = array of TQuestion;
var
Form3: TForm3;
var
Questions: TQuestionArray;
procedure TForm7.AddNewQuestionClick(Sender: TObject);
begin
SetLength(Questions, Length(Questions) + 1);
Questions[High(Questions)].InitQuestion(GetNextQuestionID,
NewQuestDesc.Text,
NewQuestAns.Text);
end;
If you really want to do it individually setting the fields:
procedure TForm7.AddNewQuestionClick(Sender: TObject);
var
Idx: Integer;
begin
SetLength(Questions, Length(Questions) + 1);
Idx := High(Questions);
Questions[Idx].QuestionID := GetNextQuestionID;
Questions[Idx].Question := NewQuestDesc.Text;
Questions[Idx].Answer := NewQuestAns.Text;
end;
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 7 years ago.
Improve this question
I'm trying to encode a stream of image using EncodeBase64 in encddecd.pass that save to the database in a blob field. And retrieve this using decodebase64 in a bytestream that put into a component for showing.
The process good done but image don't show in component.
Here's digest code:
procedure TProcessSave.Execute;
var
i : Integer;
fileStm : TStream;
memStm : TMemoryStream;
encode_plc : string;
begin
for i := 0 to StrList.Count - 1 do
begin
DM.idb_tbl.Append;
DM.idb_tbl.FieldByName('name').AsString := ExtractFileName(StrList.Strings[i]);
try
fileStm := TFileStream.Create(StrList.Strings[i], fmOpenReadWrite);
memStm := TMemoryStream.Create;
filestm.Seek(0, soFromBeginning);
memStm.LoadFromStream(fileStm);
DM.idb_tbl.FieldByName('file').Value := EncodeBase64(memStm.Memory, memStm.Size);
finally
fileStm.Free;
memStm.Free;
end;
DM.idb_tbl.Post;
end;
end;
and for loading:
procedure TLoadBar.Execute;
var
imgStm : TStream;
begin
with DM.idb_qry do
begin
DatabaseName := DM.idb_db.DatabaseName;
SQL.Text := 'SELECT * FROM pics_tbl';
Open;
First;
while not Eof do
begin
try
imgStm :=TBytesStream.Create(DecodeBase64(FieldByName('file').Value));
idx := imgBar_iemv.AppendImage;
imgBar_iemv.SetImageFromStream(idx, imgStm);
imgBar_iemv.ImageID[idx] := id;
finally
imgStm.Free;
end;
Next;
end;
end;
end;
and then I use imgStm for showing picture in a component but images not showing. I'm sure from component. What are your thoughts for encode and decode in my methods? Is another way that is sure for encode and decode for this problem?
I need to create an install.log of the selected components in the install destination folder ({app}) but I'm getting in issue when i run that installer that says "File does not exist C:/tmp/exe/install.log" I'm assuming that means it has not created the dir "exe" yet. How can i circumvent this?
procedure CurStepChanged(CurStep: TSetupStep);
var
I: Integer;
LogList: TStringList;
begin
if CurStep = ssInstall then
begin
LogList := TStringList.Create;
try
LogList.Add('Selected components:');
for I := 0 to WizardForm.ComponentsList.Items.Count - 1 do
if WizardForm.ComponentsList.Checked[I] then
LogList.Add('Component: ' + WizardForm.ComponentsList.ItemCaption[I]);
LogList.SaveToFile(ExpandConstant('{app}\install.log'));
finally
LogList.Free;
end;
end;
end;
I suspect you're trying to access the folder too early in the process, before it's actually been created yet.
Try changing to a later step in the process, such as ssPostInstall. At that point, you'll know for certain that the folder has been created. The rest of your code should be able to stay the same.
procedure CurStepChanged(CurStep: TSetupStep);
var
I: Integer;
LogList: TStringList;
begin
if CurStep = ssPostInstall then
begin
LogList := TStringList.Create;
try
LogList.Add('Selected components:');
for I := 0 to WizardForm.ComponentsList.Items.Count - 1 do
if WizardForm.ComponentsList.Checked[I] then
LogList.Add('Component: ' + WizardForm.ComponentsList.ItemCaption[I]);
LogList.SaveToFile(ExpandConstant('{app}\install.log'));
finally
LogList.Free;
end;
end;
end;