I have the next unction on a DLL:
function PedirContraseña() : string;
var
clave, claveCodificada : string;
begin
clave := InputBox('Autenticación', 'Introduzca la clave de acceso', '');
claveCodificada := SHA256Hash(clave);
Result := claveCodificada;
end;
exports PedirContraseña;
It asks to the user for a password, then it applies the SHA256 hash and returns the result of this hash.
On the main application I have the following call:
function PedirContraseña() : string; external 'seguridad.dll';
procedure Tmenubodega.BitBtn1Click(Sender: TObject);
var
s : string;
begin
inherited;
s := PedirContraseña;
ShowMessage(s);
end;
The first time I click the button it works fine.
The second time it still works.
From now, each 2 clicks it will show an Access Violation exception on the dll (1 time does, next time doesn't, next time does, next time doesn't...)
I'm confused. What can I do?
Thank's in advance
Related
I'm really new to Delphi and have not yet worked with SQL (I'm a complete beginner).
I use code to connect my database and tables to my program, but as soon as I run my program, I get a Syntax error in FROM clause message.
When I select break, it highlights end; of a part of the code.
function TADOCommand.Execute(var RecordsAffected: Integer;
const Parameters: OleVariant): _Recordset;
var
VarRecsAffected: OleVariant;
begin
SetConnectionFlag(cfExecute, True);
try
Initialize;
Result := CommandObject.Execute(VarRecsAffected, Parameters,
Integer(CommandObject.CommandType) + ExecuteOptionsToOrd
(FExecuteOptions));
RecordsAffected := VarRecsAffected;
finally
SetConnectionFlag(cfExecute, False);
end;
end;
I have three tables, of which two display on their grids, but one is not displaying on the grid, and also gives me the Syntax error in FROM clause when I want to do anything with it.
This is the code that I used to connect my database in the datamodule:
unit dmChamps_u;
interface
uses
System.SysUtils, System.Classes, ADODB, DB; // add Ado and DB
type
TdmChamps = class(TDataModule)
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
conArchers: TADOConnection;
tblArchers: TADOTable;
tblJT: TADOTable;
tblMatches: TADOTable;
dscArchers: TDataSource;
dscMatches: TDataSource;
dscJT: TDataSource;
end;
var
dmChamps: TdmChamps;
implementation
{%CLASSGROUP 'Vcl.Controls.TControl'}
{$R *.dfm}
procedure TdmChamps.DataModuleCreate(Sender: TObject);
begin
// create objects
conArchers := TADOConnection.Create(dmChamps);
tblArchers := TADOTable.Create(dmChamps);
tblMatches := TADOTable.Create(dmChamps);
tblJT := TADOTable.Create(dmChamps);
dscArchers := TDataSource.Create(dmChamps);
dscMatches := TDataSource.Create(dmChamps);
dscJT := TDataSource.Create(dmChamps);
// setup connection
conArchers.ConnectionString :=
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=ArchChampsDB.mdb;Mode=ReadWrite;Persist Security Info=False';
conArchers.LoginPrompt := false;
conArchers.Open;
// setup table archers
tblArchers.Connection := conArchers;
tblArchers.TableName := 'Archers';
// setup data source
dscArchers.DataSet := tblArchers;
tblArchers.Open;
// setup table matches
tblMatches.Connection := conArchers;
tblMatches.TableName := 'Matches';
// setup data source
dscMatches.DataSet := tblMatches;
tblMatches.Open;
// setup table JT
tblJT.Connection := conArchers;
tblJT.TableName := 'Judges/Timekeepers';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
end;
end.
I've looked through all of the questions on the From clause error already on the site, but none of the scenarios quite match my problem. I also went to Embarcadero's site and read about TableDirect, which I thought might be a possible solution, but it was already in the code.
Your error is here
tblJT.TableName := 'Judges/Judges';
You can't has a table with that name, or Judges or Timekeepers
You can solve do it:
// setup table J
tblJT.Connection := conArchers;
tblJT.TableName := 'Judges';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
Separated
// setup table T
tblJT.Connection := conArchers;
tblJT.TableName := 'Timekeepers';
// setup data source
dscJT.DataSet := tblJT;
tblJT.Open;
Maybe it is because of the slash in 'Judges/Timekeepers'.
Did you try to debug step by step going to the code in DataModuleCreate?
I would like to make a terminal with a Lazarus GUI application. But I'm in trouble. And I hope someone can help me, please.
Question1: The Chinese and other special chars cannot display normally, I would like to know how to fix this problem.
(code)Class of the thread and "run" button on click event
screenshot
Question2: I want to know how to input some command into the console. I tried to start a Windows cmd, and use "winver" command. But when I click the button, nothing happened.
The send command button
Winver is not console but a GUI program. To run a program with output into memo, use the following code, which retrieves version using the cmd.exe "ver" command. You can try to use this template for the first question too.
unit mainprocesstomemo;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Process, Pipes;
Type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
public
procedure ProcessEvent(Sender,Context : TObject;Status:TRunCommandEventCode;const Message:string);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TProcessMemo }
Type
TProcessToMemo = class(TProcess)
public
fmemo : Tmemo;
bytesprocessed : integer;
fstringsadded : integer;
function ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean;override;
end;
function RunCommandMemo(const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone;memo:TMemo=nil;runrefresh : TOnRunCommandEvent=nil ):boolean;
Var
p : TProcessToMemo;
i,
exitstatus : integer;
ErrorString : String;
begin
p:=TProcessToMemo.create(nil);
if Options<>[] then
P.Options:=Options - [poRunSuspended,poWaitOnExit];
p.options:=p.options+[poRunIdle];
P.ShowWindow:=SwOptions;
p.Executable:=exename;
if high(commands)>=0 then
for i:=low(commands) to high(commands) do
p.Parameters.add(commands[i]);
p.fmemo:=memo;
p.OnRunCommandEvent:=runrefresh;
try
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
finally
p.free;
end;
if exitstatus<>0 then result:=false;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var s : string;
begin
//RunCommandMemo('testit',[],s,[],swonone,memo1,ProcessEvent);
RunCommandMemo('cmd.exe',['/w','/c','ver'],s,[],swonone,memo1,ProcessEvent);
end;
procedure TForm1.ProcessEvent(Sender, Context: TObject;
Status: TRunCommandEventCode; const Message: string);
begin
if status in [RunCommandIdle, RunCommandFinished] then
begin
if status =RunCommandFinished then
begin
memo1.lines.add(' process finished');
end;
if tprocesstomemo(sender).fstringsadded>0 then
begin
tprocesstomemo(sender).fstringsadded:=0;
// memo1.lines.add('Handle:'+inttostr(tprocesstomemo(sender).ProcessHandle));
memo1.refresh;
end;
sleep(10);
application.ProcessMessages;
end;
end;
{ TProcessToMemo }
function TProcessToMemo.ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean;
var lfpos : integer;
crcorrectedpos:integer;
stradded : integer;
newstr : string;
begin
Result:=inherited ReadInputStream(p, BytesRead, DataLength, data, MaxLoops);
if (result) and (bytesread>bytesprocessed)then
begin
stradded:=0;
lfpos:=pos(#10,data,bytesprocessed+1);
while (lfpos<>0) and (lfpos<=bytesread) do
begin
crcorrectedpos:=lfpos;
if (crcorrectedpos>0) and (data[crcorrectedpos-1]=#13) then
dec(crcorrectedpos);
newstr:=copy(data,bytesprocessed+1,crcorrectedpos-bytesprocessed-1);
fmemo.lines.add(newstr);
inc(stradded);
bytesprocessed:=lfpos;
lfpos:=pos(#10,data,bytesprocessed+1);
end;
inc(fstringsadded,stradded); // check idle event.
end;
end;
end.
I don't know minecraft server, and many external programs might do weird things to the console. But a simple combination of programs to test with is here http://www.stack.nl/~marcov/files/processmemodemo.zip
I use this example to send a string between two applications.
When I press the Send button for the first time, the string is sent to the Receiver, but only a part of the string is received.
When I press the Send button for the second time, I get "Window not found!".
The window is right there on screen. Why it works when I press the button the first time, but not the second time?
This is the sender:
procedure TfrmSender.SendString;
var
stringToSend : string;
copyDataStruct : TCopyDataStruct;
begin
Caption:= 'Sending';
stringToSend := 'About - Delphi - Programming';
copyDataStruct.dwData := 12821676; //use it to identify the message contents
copyDataStruct.cbData := 1 + Length(stringToSend) ;
copyDataStruct.lpData := PChar(stringToSend);
SendData(copyDataStruct) ;
end;
procedure TfrmSender.SendData(CONST copyDataStruct: TCopyDataStruct);
VAR
receiverHandle : THandle;
res : integer;
begin
receiverHandle := FindWindow(PChar('TfrmReceiver'), PChar('frmReceiver')) ;
if receiverHandle = 0 then
begin
Caption:= 'Receiver window NOT found!';
EXIT;
end;
res:= SendMessage(receiverHandle, WM_COPYDATA, Integer(Handle), Integer(#copyDataStruct));
if res= 0 then Caption:= 'Receiver window found but msg not hand';
end;
And this is the receiver:
procedure TfrmReceiver.WMCopyData(var Msg: TWMCopyData);
VAR
s : string;
begin
if Msg.CopyDataStruct.dwData = 12821676 then
begin
s := PChar(Msg.CopyDataStruct.lpData);
msg.Result := 2006; //Send something back
Winapi.Windows.Beep(800, 300);
Caption:= s;
end
end;
To summarize the comments there are two errors
1) (See #Tom Brunberg) is that the length is set incorrectly which is why you only get part (about half? of the string)
It should be
copyDataStruct.cbData := sizeof( Char )*(Length(stringToSend) + 1 );
2) The forms caption is being changed which invalidates the expression
FindWindow(PChar('TfrmReceiver'), PChar('frmReceiver'))
because the second parameter is the form's caption (in Delphi terminology)
I'm trying to figure out how to run a stored procedure using firedac
unit DataLayer.OilCommanderConnection;
interface
uses
FireDAC.Phys.FB,
Generics.Collections,
Model.Sample,
Model.Batch,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error,
FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool,
FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL, Data.DB,
FireDAC.Comp.Client, FireDAC.Phys.MSSQL,
FireDAC.DApt,
FireDAC.Comp.UI
;
type
TOilCommanderConnection = class
strict private
public
Connection : TFDConnection;
function GetSampleTypesForBatch(Batch : TBatch) : Boolean;
function Connect:Boolean;
constructor Create;
destructor Destroy; override;
end;
implementation
uses
SysUtils
;
function TOilCommanderConnection.Connect:Boolean;
var
OK : Boolean;
begin
OK := true;
Connection := TFDConnection.Create(nil);
try
Connection.Params.LoadFromFile('MSSQL.ini');
finally
Result := OK;
end;
end;
function TOilCommanderConnection.GetSampleTypesForBatch(Batch : TBatch) : Boolean;
var
StoredProc : TFDStoredProc;
begin
Connect;
StoredProc := TFDStoredProc.Create(nil);
try
StoredProc.Connection := Connection;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.FetchOptions.Items := StoredProc.FetchOptions.Items - [fiMeta];
with StoredProc.Params do
begin
Clear;
with Add do
begin
Name := 'BatchNo';
ParamType := ptInput;
DataType := ftString;
Size := 6;
end;
end;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.Params[0].Value := Batch.RackNo;
StoredProc.ExecProc;
while not StoredProc.Eof do
begin
//StoredProc.FieldByName('').AsS
StoredProc.Next;
end;
finally
FreeAndNil(StoredProc);
end;
Result := true;
end;
constructor TOilCommanderConnection.Create;
begin
inherited;
Connection := TFDConnection.Create(nil);
end;
destructor TOilCommanderConnection.Destroy;
begin
if Assigned(Connection) then FreeAndNil(Connection);
inherited;
end;
end.
I get an error message a the first occurrence of the line
StoredProc.Prepare;
Here is the message
--------------------------- Debugger Exception Notification
Project RefractiveIndexTests.exe raised exception class Exception with message 'Object factory for class
{3E9B315B-F456-4175-A864-B2573C4A2201} is missing. To register it, you
can drop component [TFDGUIxWaitCursor] into your project'.
I've called the function using
OilCommanderConnection.GetSampleTypesForBatch(batch);
from a test project.
the tutorial I read didn't explain what to do about this situation.
I've tried adding TFDGUIxWaitCursor into my project as the error message suggests but this has not made any difference. I wonder if this problem is related to me keeping the Database connection logic in a separate unit to my Main Form. I would like to be able to separate my user interface from my Data Layer.
Depending on the type of your application, include one of the following units into any one "uses" clause:
FireDAC.VCLUI.Wait - for VCL applications;
FireDAC.FMXUI.Wait - for FireMonkey applications;
FireDAC.ConsoleUI.Wait - for console / non-visual applications.
So I've started playing with SMS and I've tried to make a program (label and button) to hit a website with a post request and display the result.
I have no problems with Hints/Warnings/Errors and everything looks good to me. The following code is a rework of a couple of existing examples mashed together.
procedure TForm1.ExecuteCmd;
var
whttp : TW3HttpRequest;
wParams : string;
begin
wHttp := TW3HttpRequest.Create;
try
whttp.OnDataReady := lambda (Sender)
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
whttp.OnReadyStateChange := lambda (Sender)
if (wHttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://www.server1.com/executecmd.php');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
finally
wHttp.free;
end;
end;
procedure TForm1.W3Button1Click(Sender: TObject);
begin
ExecuteCmd;
end;
The problem is this, when I actually click the button I get the following error message:
Uncaught TypeError: Cannot read property 'readyState' of null [line #6277]
The error is in the auto generated code and seems to have no relation to what I've written specifically. If I take out all references to ReadyState from my code I still get the error.
What am I missing? I feel like it has something to do with the Lambda functions.
Your problem is that you are expecting whttp.Send to block. Send, as its JavaScript equivalent, is asynchronous. Before the POST could even execute, whttp object is freed (in the finally block). When callback (OnReadyStateChanged) is called, whttp was already freed (and is now null) and you are then trying to call ReadyState on that freed (null) object.
Another reason for confusion is that object.Free in Delphi for Windows/OS X destroys the object while in Smart it merely sets the object reference to nil and leaves the destruction to JavaScript's garbage collection. That's why the whttp is still alive after the Free and why the OnReadyStateChanged is called at all.
This works fine:
uses
W3System, W3Graphics, W3Components, W3Forms, W3Fonts, W3Borders, W3Application,
W3Button, W3Inet, W3Memo;
type
TForm1=class(TW3form)
procedure W3Button1Click(Sender: TObject);
private
{$I 'Form1:intf'}
whttp: TW3HttpRequest;
protected
procedure InitializeForm; override;
procedure InitializeObject; override;
procedure Resize; override;
end;
implementation
{ TForm1}
procedure TForm1.W3Button1Click(Sender: TObject);
var
wParams: string;
begin
whttp := TW3HttpRequest.Create;
whttp.OnReadyStateChange := lambda (Sender)
if (whttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
W3Memo1.Text := wHttp.ResponseText;
whttp.OnReadyStateChange := nil;
whttp := nil;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://httpbin.org/post');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
end;