Howdy, Pascal masters!
I've got a file type of custom records:
DBCell = record
Name: string[10];
Surname: string[15];
Balance:integer;
OpenDate: record
year: integer;
month: 1..12;
day:1..31
end;
AccountN: string[10];
end;
DBFile = file of DBCell;
And functions, that open and add new element to file:
procedure Fopenf(var F:DBFile; var FName:string; var FOpened:boolean);
begin
Assign(F,FName);
rewrite(F);
FOpened:=true;
end;
procedure InsN(var F:DBFile;var cell:DBCell;var FOpened:boolean);
begin
Write(F,cell);
Close(F);
Rewrite(F);
Writeln('Added');
FOpened:=false;
end;
Problem is, nothing is actually written to file. What am I doing wrong?
It's been a long time since I've done any Pascal, but IIRC Rewrite truncates the file. You should use Append.
You don't need the Rewrite() after inserting a record in the file:
procedure InsN(var F:DBFile;var cell:DBCell;var FOpened:boolean);
begin
Write(F,cell);
Close(F);
Writeln('Added');
FOpened:=false;
end;
If you don't want to truncate the file every time you open it:
procedure Fopenf(var F:DBFile; var FName:string; var FOpened:boolean);
begin
Assign(F,FName);
append(F);
FOpened:=true;
end;
The problem is the 'rewrite' call in InsN. 'Rewrite' creates a new file, so by calling it at the end of your program, you are creating a new, empty file!
Related
I have problem inserting sql results into TStringGrid.I have following code:
var i:Integer;
begin
SqlQuery1.SQL.Text:= 'SELECT * FROM `users`';
SqlQuery1.Open;
MySql55Connection1.Open;
i:= 0;
while not SQLQUERY1.EOF do
begin
i:= i+1;
StringGrid1.Cells[0,i]:= SqlQuery1.FieldByName('Username').AsString;
StringGrid1.Cells[1,i]:= SqlQuery1.FieldByName('Password').AsString;
StringGrid1.Cells[2,i]:= SqlQuery1.FieldByName('id').AsString;
end;
end;
So in my database only one line. But program adding a lot of copies of this line in StringGrid and it causes error(Index out of bounds).
Danger
It appears you are storing passwords in plain text form in a database.
This is an extremely bad idea.
Never store passwords in a database.
Use salted hashes instead.
See: How do I hash a string with Delphi?
There are a couple of other problems in your code:
You don't ensure that the stringgrid has enough rows to hold your data.
You're not moving to the next line in the query.
You're opening the query before the connection is open.
You're using FieldByName inside a loop, this is going to be very slow.
Simple solution
Use a DBGrid.
If you insist on using a StringGrid
I suggest refactoring the code like so:
var
i,a:Integer;
FUsername, FPasswordHash, Fid, FSalt: TField;
begin
if not(MySQl55Connection.Active) then MySql55Connection1.Open;
SqlQuery1.SQL.Text:= 'SELECT * FROM users'; //only use backticks on reserved words.
SqlQuery1.Open;
FUsername:= SqlQuery1.FieldByName('Username');
//do not use plain text passwords!!
FPasswordHash:= SQLQuery1.FieldByName('SaltedPasswordHashUsingSHA256');
FId:= SqlQuery1.FieldByName('id');
FSalt:= SQLQuery1.FieldByName('SaltUsingCryptoRandomFunction');
a:= StringGrid1.FixedRowCount;
if SQLQuery1.RecordCount = -1 then StringGrid1.RowCount = 100 //set it to something reasonable.
else StringGrid1.RowCount:= a + SQLQuery1.RecordCount;
//SQLQuery1.DisableControls
try
i:= StringGrid1.FixedRowCount;
while not(SQLQuery1.EOF) do begin
if i >= StringGrid1.RowCount then StringGrid1.RowCount:= i;
StringGrid1.Cells[0,i]:= FUserName.AsString;
StringGrid1.Cells[1,i]:= FPasswordHash.AsString;
StringGrid1,Cells[3,i]:= FSaltInHex.AsString;
StringGrid1.Cells[2,i]:= FId.AsString;
SQLQuery1.Next; //get next row.
Inc(i);
end; {while}
finally
//just in case you want to do endupdate or close the SQLQuery or do SQLQuery1.EnableControls
end;
end;
Basic security example
Here's how to hash a password:
Download Lockbox3.
Put a THash on your form and set the hash property to SHA-512.
Use the following code to produce a hash result.
function StringToHex(const input: string): AnsiString;
var
NumBytes, i: Integer;
B: Byte;
W: word;
Wa: array[0..1] of byte absolute W;
begin
NumBytes := input.length * SizeOf(Char);
SetLength(Result, NumBytes * 2);
for i := 1 to NumBytes do begin
if SizeOf(Char) = 1 then begin
B:= Byte(input[i]);
BinToHex(#B, #Result[(I*2)+1], 1);
end else begin
W:= Word(input[i]);
BinToHex(#Wa[0], #Result[(i*4+0)],1);
BinToHex(#Wa[1], #Result[(i*4+1)],1);
end; {else}
end;
end;
function TForm1.HashPassword(var Password: string; const Salt: string): string;
var
KillPassword: pbyte;
begin
Hash1.HashString(StringToHex(Password)+StringToHex(Salt));
KillPassword:= PByte(#Password[1]);
FillChar(KillPassword^, Length(Password)*SizeOf(Char), #0); //remove password from memory.
Password:= ''; //Now free password.
end;
function GenerateSalt( ByteCount: integer = 32): string;
var
Buffer: TMemoryStream;
begin
Buffer := TMemoryStream.Create;
try
Buffer.Size := ByteCount;
RandomFillStream( Buffer);
result := Stream_to_Base64( Buffer);
finally
Buffer.Free
end;
end;
This is the minimum amount of work you can get away with whilst still having things secure.
Do not think that your passwords are unimportant because you just have a toy database, because people reuse passwords and thus your toy passwords end up being the same passwords used for online banking and such.
People are lazy....
I have an issue on rewriting my .txt file, did I made some mistake? The program run smoothly though. This is a piece of my library.
//global variable
uses utheatre;
var loadUDT:TheatreUDT;
//utheatre library
type
TheatreUDT = record
Member:text;
end;
procedure load_main(var loadUDT : TheatreUDT);
begin
load_Member(loadUDT.Member);
end;
procedure load_Member(var Member:text);
begin
assign (Member,'Data/Member.txt');
end;
procedure regis(var loadUDT:TheatreUDT);
var
s:string;
begin
rewrite(loadUDT.Member);
write('> Input Username : ');
readln(s);
write(loadUDT.Member,s);
write(loadUDT.Member,' | ');
write('> Input Password : ');
readln(s);
write(loadUDT.Member,s);
writeln(loadUDT.Member,' | 100000');
writeln('> Registration Successful');
end;
procedure exit(var loadUDT:TheatreUDT; var bool_main:boolean);
begin
close(loadUDT.Member);
bool_main := False;
end;
I expected the output inside my notepad will be
username | password | 100000
but it seems that the Member.txt is not updated. Thanks before.
EDIT : This is My Main Program
begin
bool_main := True;
while(bool_main) do begin
write('> ');
readln(input_main);
case input_main of
'load' : load_main(loadUDT);
'register' : regis(loadUDT);
'exit' : exit();
end;
end;
end.
N.B. I found out that when I add "close(loadUDT.Member)" inside my "regis procedure", it worked, however it didn't work when i insert the "close(loadUDT.Member)" inside the "exit procedure". Any ideas why? Thanks again before.
Nevermind, I found the answer already. exit() is reserved. Sorry Guys.
N.B. Thanks to #gammatester
I would like to write a function that checks if a certain letter is in a certain word.
That is the current function (sry for the german)
function woistderbuchstabe (wort, buchstabe:String):String;
VAR i: Integer;
begin
for i:=1 to length(wort) do
if wort[i]=buchstabe then
showmessage(INTtoSTR(i))
//LB_ausgabe.items.add(INTtoSTR(i));
end;
The way it's written now the function actually works. It shows one or several messages with the position(s) of the letter searched for (the variable "buchstabe") in the word "wort". E.g. for wort=abctc and buchstabe=c it shows 3 and 5.
But if i would write it this way
function woistderbuchstabe (wort, buchstabe:String):String;
VAR i: Integer;
begin
for i:=1 to length(wort) do
if wort[i]=buchstabe then
LB_ausgabe.items.add(INTtoSTR(i));
end;
(remove the showmessage and make the ListBox thing actual code)
then I get the error
Undefined Identifier: 'LB_ausgabe'
This is the complete code of the Unit
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
E_kette: TEdit;
E_buchstabe: TEdit;
B_start: TButton;
LB_ausgabe: TListBox;
procedure B_startClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function woistderbuchstabe (wort, buchstabe:String):String;
VAR i: Integer;
begin
for i:=1 to length(wort) do
if wort[i]=buchstabe then
showmessage(INTtoSTR(i))
//LB_ausgabe.items.add(INTtoSTR(i));
end;
procedure TForm1.B_startClick(Sender: TObject);
begin
woistderbuchstabe (E_kette.text, E_buchstabe.text);
end;
end.
Pls try to be specific as I'm pretty clueless about Delphi.
Thanks in advance
Function woistderbuchstabe is not a member of your class TForm1... so it doesn't have direct access to it's members unless you specify an instance. I suggest this fix:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
E_kette: TEdit;
E_buchstabe: TEdit;
B_start: TButton;
LB_ausgabe: TListBox;
procedure B_startClick(Sender: TObject);
private
{ Private-Deklarationen }
function woistderbuchstabe (wort, buchstabe:String):String;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.woistderbuchstabe (wort, buchstabe:String):String;
VAR i: Integer;
begin
for i:=1 to length(wort) do
if wort[i]=buchstabe then
LB_ausgabe.items.add(INTtoSTR(i));
end;
procedure TForm1.B_startClick(Sender: TObject);
begin
woistderbuchstabe (E_kette.text, E_buchstabe.text);
end;
end.
But you can also just reference your Form1: TForm1 instance (global variable), in your function (I recommend you stick with the OO approach, though):
Form1.LB_ausgabe.items.add(INTtoSTR(i));
PS: Check Pos and PosEx functions too, as they are probably (I never benchmarked) faster solution, since they are asm implemented.
In my opinion, if you might need to use this logic from somewhere else, you need to decouple it from your user interface. You can do this by changing your function to a procedure that accepts a more generic class to populate (like a plain old TStrings) as a parameter. As TStrings is a common base for TComboBox.Items, TListBox.Items, TMemo.Lines and is used in many other places, this seems like the most flexible way to accomplish what you want to do.
procedure woistderbuchstabe (List: TStrings; wort, buchstabe:String);
VAR i: Integer;
begin
for i := 1 to length(wort) do
if wort[i] = buchstabe then
List.Add(InttoStr(i));
end;
This allows you to use the procedure with your TListBox (call it with LB_ausgabe.items, a TMemo, using Memo1.Lines, a TComboBox with Combobox1.Items, a TRichEdit with RichEdit1.Lines, or a plain old TStringList directly with SL.
You can now call it from anywhere you want, such as a TForm.Button1Click(Sender: TObject), using ListBox1.Items, or a standalone method that creates and passes in a TStringList. It's not tied to a specific form, so it's more flexible and able to be reused elsewhere.
I have a form with 7 TEdit having name EditPhone1, EditPhone2 and so on.
In the same form I query a DB to get data to fill those TEdits. Of course I cannot know in advance how many results the query will return.
How can I call the various TEdit objects when looping on the rowcount of the query?
Use FindComponent to "convert" a component name to the component itself:
var
Edit: TEdit;
I: Integer;
begin
DataSet.First;
I := 1;
while not DataSet.Eof do
begin
Edit := TEdit(FindComponent(Format('EditPhone%d', [I])));
if Edit <> nil then
Edit.Text := DataSet.FieldValues['PhoneNo'];
DataSet.Next;
Inc(I);
end;
Now, this requires to hard-code the EditPhone%d string into the source which results in all kinds of maintainability issues. For example: consider renaming the edits.
Alternative 1:
To not rely on the component names, you could instead make use of TLama's idea and add all the edits to a list:
uses
... , Generics.Collections;
type
TForm1 = class(TForm)
EditPhone1: TEdit;
...
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FEdits: TList<TEdit>;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FEdits := TList<TEdit>.Create;
FEdits.AddRange([EditPhone1, EditPhone2, EditPhone3, EditPhone4, EditPhone5,
EditPhone6, EditPhone7]);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FEdits.Free;
end;
procedure TForm1.ADOQuery1AfterOpen(DataSet: TDataSet);
var
I: Integer;
begin
DataSet.First;
I := 0;
while (not DataSet.Eof) and (I < FEdits.Count) do
begin
FEdits[I].Text := DataSet.FieldValues['PhoneNo'];
DataSet.Next;
Inc(I);
end;
end;
This still requires some maintenance in case of adding edits in future.
Alternative 2:
You could also loop over all edits in the form to find the ones tagged to be added to the list, instead of adding them each explicitly:
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
FEdits := TList<TEdit>.Create;
for I := 0 to ComponentCount - 1 do
if (Components[I] is TEdit) and (TEdit(Components[I]).Tag = 1) then
FEdits.Add(TEdit(Components[I]));
end;
But keeping those tags up to date is another burden.
Alternative 3:
I suggest you use a TDBGrid which is a data-component. Opening the linked dataset will automatically add all phone numbers to the grid. With some settings, the grid may kind of look like a couple of edits below each other.
You can, for example, use Tag property, to find needed component. Set all you TEdit's tag from 1 to 7 (or more), and find component by:
Var I: Integer;
MyEdit : TEdit;
For I = 0 To Self.ComponentCount - 1 Do
if (Self.Components[I] IS TEdit) AND (Self.Components[I] AS TEdit).Tag = YourTag
MyEdit = (Self.Components[I] AS TEdit);
You can also dynamically create so many TEdits, you need, and assign Tag property on creation, and find it this code later in runtime.
I'd suggest using DBCtrlGrid. You place your controls for one row on it, and it repeats the controls for as many rows as your data set has.
Get query result (usually using .RowCount property of TDataset return)
After getting the number of row, do iteration to make TEdit and set the text property
Here is sample of code:
...
For i:=0 to RowCount do
Begin
A:=TEdit.Create(self);
A.Parent:=AForm;
A.Top:=i*14;
A.Text:=ADataset.Field(i).AsString;
End;
...
How to set entire HTML in MSHTML?
I am trying using this assignment:
(Document as IHTMLDocument3).documentElement.innerHTML := 'abc';
but I got the error:
"Target element invalid for this
operation"
I've also tried using
(Document as IHTMLDocument2).write
but this form only adds HTML into the body section, and I need to replace all the HTML source.
Does somebody have any idea of how I do this?
Thanks in advance.
Here's some of my old code, see if it helps you:
type
THackMemoryStream = class(TMemoryStream);
procedure Clear(const Document: IHTMLDocument2);
begin
Document.write(PSafeArray(VarArrayAsPSafeArray(VarArrayOf([WideString('')]))));
Document.close;
end;
procedure LoadFromStream(const Document: IHTMLDocument2; Stream: TStream);
var
Persist: IPersistStreamInit;
begin
Clear(Document);
Persist := (Document as IDispatch) as IPersistStreamInit;
OleCheck(Persist.InitNew);
OleCheck(Persist.Load(TStreamAdapter.Create(Stream)));
end;
procedure SetHtml(const Document: IHTMLDocument2; const Html: WideString);
var
Stream: TMemoryStream;
begin
Stream := TMemoryStream.Create;
try
THackMemoryStream(Stream).SetPointer(PWideChar(Html), (Length(Html) + 1) * SizeOf(WideChar));
Stream.Seek(0, soFromBeginning);
LoadFromStream(Document, Stream);
finally
Stream.Free;
end;
end;
As an alternative you can also use TEmbededWB which is an extended wrapper around a web browser and has some easy to use methods that provide this functionality.