let's see if yaw can help me out here,
Supposing there's a link: www.example.com/test.html
Upon opening, it would show either 0 or 1.
I need to fetch that value. I.e.:
if internet.value := 0 then ShowMessage('False') else ShowMessage('True');
It could be using indy components or winsockets, how would I go about this one?
If you're talking about a plain text file containing just an integer value, you can use Indy for this e.g. this way. The following function returns True, when the page downloading succeeded and when the page contains an integer value, False otherwise. Please note, that I wrote it in browser so it's untested:
uses
IdHTTP;
function TryWebContentToInt(const AURL: string; out AValue: Integer): Boolean;
var
S: string;
IdHTTP: TIdHTTP;
begin
IdHTTP := TIdHTTP.Create(nil);
try
IdHTTP.HandleRedirects := True;
try
S := IdHTTP.Get(AURL);
Result := TryStrToInt(S, AValue);
except
Result := False;
end;
finally
IdHTTP.Free;
end;
end;
And the usage:
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
if TryWebContentToInt('http://example.com/page.html', I) then
ShowMessage('Value: ' + IntToStr(I))
else
ShowMessage('Page downloading failed or it doesn''t contain an integer value!');
end;
Related
Here its a VCL app and I have a link with my Ini file and I wanna keep adding lines in there with time and date stamps with press of a button.
private
FLog: TStringList;
FIni: TIniFile;
aTime: TDateTime;
procedure TForm2.btnBreakClick(Sender: TObject);
begin
FLog := TStringList.Create;
try
aTime := Now;
begin
FIni.WriteString('FileName', 'Break', FormatDateTime('dd/mm/yyyy hh:nn', aTime));
end;
finally
FLog.Free;
end
end;
With this piece of code I can only replace the previous time and date stamp I have tried to do it with a for loop but without succes.
This is the outcome with the current few lines of code.
[FileName]
Break=09-10-2018 13:35
And what I want is that everytime I hit the break button it needs to add on to the file with a other time.
An INI file contains key/value pairs. To do what you are asking for, you need to create a unique key name with every button press, otherwise you are just overwriting an existing value each time, as you have already discovered.
Try something more like this:
procedure TForm2.btnBreakClick(Sender: TObject);
var
Keys: TStringList;
MaxBreak, I, Num: Integer;
begin
MaxBreak := 0;
Keys := TStringList.Create;
try
FIni.ReadSection('FileName', Keys);
for I := 0 to Keys.Count-1 do
begin
if StartsText('Break', Keys[I]) then
begin
if TryStrToInt(Copy(Keys, 6, MaxInt), Num) then
begin
if Num > MaxBreak then
MaxBreak := Num;
end;
end;
end;
finally
Keys.Free;
end;
FIni.WriteString('FileName', 'Break'+IntToStr(MaxBreak+1), FormatDateTime('dd/mm/yyyy hh:nn', Now));
end;
Or this:
procedure TForm2.btnBreakClick(Sender: TObject);
var
I: Int64;
Key: string;
begin
for I := 1 to Int64(MaxInt) do
begin
Key := 'Break' + IntToStr(I);
if not FIni.ValueExists('FileName', Key) then
begin
FIni.WriteString('FileName', Key, FormatDateTime('dd/mm/yyyy hh:nn', Now));
Exit;
end;
end;
end;
Or this:
procedure TForm2.btnBreakClick(Sender: TObject);
var
NumBreaks: Integer;
begin
NumBreaks := FIni.ReadInteger('FileName', 'NumBreaks', 0);
Inc(NumBreaks);
FIni.WriteInteger('FileName', 'NumBreaks', NumBreaks);
FIni.WriteString('FileName', 'Break' + IntToStr(NumBreaks), FormatDateTime('dd/mm/yyyy hh:nn', Now));
end;
Although you referred to TIniFile, your post and your comments tell me that that is not necessarily what you want. TIniFile is not really intended for the kind of usage you are describing, although it can be used (as the other answer shows).
For simple recording of events I suggest an ordinary text file, and for adding events to it, a TStringList as in the following example. The example is a simplified extract from code I used myself long time ago.
var
EventFile: TFileName;
procedure EventRecorder(EventTime: TDateTime; Description, Comment: string);
var
sl: TStringList;
es: string;
begin
sl: TStringList;
try
if FileExists(EventFile) then
sl.LoadFromFile(EventFile);
es := FormatDateTime('yyyy-mm-dd hh:nn:ss', EventTime)+' '+Description+' '+comment;
sl.Add(es);
sl.SaveToFile(EventFile);
finally
sl.free;
end;
end;
Typical usage
procedure TForm2.btnBreakClick(Sender: TObject);
begin
EventRecorder(now, 'Break', '');
end;
I have been working on this for a while and I just can't get a successful response from the server.
All documentation for this can be found at the Bittrex Exchange Wesite
The main crux of the signature bit can be found under the heading Authentication
The hashing file I have been using can be found at Fundamentals on SourceForge. It is the one at the bottom called Fundamentals Hash 4.00.15
The reason I have been using this file is a very simple one, it seems to be the only one giving me a correct answer. Or should I say, it is giving me the correct answer compared to the result this Hashing Website is giving me.
I've tried using the Indy components to generate the correct hash, but it never seems to match the value from the website. Maybe I'm not using it correctly or the right libraries or something, but I will add the example for that as well that I created.
(As I write this, I've just tested again, and it does seem like I am getting the right answer, go figure, maybe I am using a better OpenSSL library. Anyway, I will also put my INDY example down below as well).
function Test: String;
const
FAPIKey = 'APIKEY';
FAPISecret = 'APISECRET';
FURL = 'https://bittrex.com/api/v1.1/account/getbalances?apikey=%s&nonce=%d';
var
FPost, FSignature: String;
FNonce: Integer;
Response: TStringStream;
HTTP: TIdHTTP;
SSL:TIdSSLIOHandlerSocketOpenSSL;
begin
Result := '';
FNonce := DateTimeToUnix(Now);
FPost := Format(FURL, [FAPIKey, FNonce]);
HTTP := TIdHTTP.Create;
try
SSL := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP);
try
HTTP.IOHandler := SSL;
FSignature := SHA512DigestToHex(CalcHMAC_SHA512(FAPISecret, FPost));
HTTP.Request.CustomHeaders.AddValue('apisign', FSignature);
Response := TStringStream.Create;
try
HTTP.Get(FPost, Response);
Result := Response.DataString;
finally
Response := nil;
end;
finally
SSL := nil;
end;
finally
HTTP := nil;
end;
end;
Prior to using this version for the hashing I was only ever getting
'{"success":false,"message":"APISIGN_NOT_PROVIDED","result":null}'
I finally moved on when I worked out the custom HTTP headers and am now getting
'{"success":false,"message":"INVALID_SIGNATURE","result":null}'
Could it be something simple as an invalid nonce, or one that is too old?
Does everything look ok or am I missing some basic component settings for the INDY components?
function Test: String;
const
FAPIKey = 'APIKEY';
FAPISecret = 'APISECRET';
FURL = 'https://bittrex.com/api/v1.1/account/getbalances?apikey=%s&nonce=%d';
var
FPost, FSignature: String;
FNonce: Integer;
Response: TStringStream;
HTTP: TIdHTTP;
SSL:TIdSSLIOHandlerSocketOpenSSL;
FSHA512Hasher: TIdHMACSHA512;
begin
Result := '';
if not LoadOpenSSLLibrary then exit;
FNonce := DateTimeToUnix(Now);
FPost := Format(FURL, [FAPIKey, FNonce]);
HTTP := TIdHTTP.Create;
try
SSL := TIdSSLIOHandlerSocketOpenSSL.Create(HTTP);
try
HTTP.IOHandler := SSL;
FSHA512Hasher := TIdHMACSHA512.Create;
try
FSHA512Hasher.Key := ToBytes(FAPISecret);
FSignature := Lowercase(ToHex(FSHA512Hasher.HashValue(ToBytes(FPost))));
finally
FSHA512Hasher := nil;
end;
HTTP.Request.CustomHeaders.AddValue('apisign', FSignature);
Response := TStringStream.Create;
try
HTTP.Get(FPost, Response);
Result := Response.DataString;
finally
Response := nil;
end;
finally
SSL := nil;
end;
finally
HTTP := nil;
end;
end;
I had a similar problem which I eventually figured out. I used the hmac.pas unit which I found via google search, but had to modify it to work with 10.1 Seattle (specifically IDBytes is a little different).
IMPORTANT: I also had to modify the hmac.pas unit to remove the '0x' from the front of the HexStr variation of the functions.
ALSO: I made all inputs ansistring.
My test function for this is as follows.
function TBTXClient.Get(sCommand, sAddParams: string): string;
var
sURL: string;
nonce: string;
res: string;
sec2: string;
sha: TIDHashSha256;
hmac: TIdHMAC;
hash: string;
ms: TMemoryStream;
begin
nonce := inttostr(getticker);
sURL := 'https://bittrex.com/api/v1.1/'+sCommand+'?apikey='+MY_KEY+'&nonce='+nonce+sAddParams;
hash := THMACUtils<TIDHMacSha512>.HMAC_HexStr(MY_SECRET,sURL);
//Debug.Log('url = '+sUrl);
//Debug.Log('hash = '+hash);
QuickHTTPSGet(sURL, res, 'apisign', hash);
result := res;
end;
My Modified version of the hmac.pas unit (has some new dependencies)
unit hmac;
interface
uses
System.SysUtils,
EncdDecd,
IdHMAC,
IdSSLOpenSSL,
helpers.indy,
idglobal,
IdHash;
type
localstringtype = ansistring;
THMACUtils<T: TIdHMAC, constructor> = class
public
class function HMAC(aKey, aMessage: localstringtype): TIdBytes;
class function HMAC_HexStr(aKey, aMessage: localstringtype): localstringtype;
class function HMAC_Base64(aKey, aMessage: localstringtype): localstringtype;
end;
implementation
class function THMACUtils<T>.HMAC(aKey, aMessage: localstringtype): TIdBytes;
var
_HMAC: T;
begin
if not IdSSLOpenSSL.LoadOpenSSLLibrary then Exit;
_HMAC:= T.Create;
try
_HMAC.Key := AnsiStringToIDBytes(aKey);
Result:= _HMAC.HashValue(AnsiStringToIDBytes(aMessage));
finally
_HMAC.Free;
end;
end;
class function THMACUtils<T>.HMAC_HexStr(aKey, aMessage: localstringtype): localstringtype;
var
I: Byte;
begin
Result:= '';//'0x';
for I in HMAC(aKey, aMessage) do
Result:= Result + IntToHex(I, 2);
end;
class function THMACUtils<T>.HMAC_Base64(aKey, aMessage: localstringtype): localstringtype;
var
_HMAC: TIdBytes;
begin
_HMAC:= HMAC(aKey, aMessage);
Result:= EncodeBase64(_HMAC, Length(_HMAC));
end;
end.
You'll probably also want this helper unit.
unit helpers.indy;
interface
uses
idglobal, types, classes, sysutils, typex;
function TBytesToIDBytes(b: TBytes): TIDBytes;
function AnsiStringToIDBytes(a: ansistring): TIDBytes;
implementation
function TBytesToIDBytes(b: TBytes): TIDBytes;
var
t: ni;
begin
setlength(result, length(b));
for t := low(b) to high(b) do
result[t] := b[t];
end;
function AnsiStringToIDBytes(a: ansistring): TIDBytes;
var
t: ni;
begin
setlength(result, length(a));
for t := 0 to length(a)-1 do
result[t] := ord(a[STRZ+t]);
end;
And this cheesy function, which I borrowed from my own https unit shows how to handle the header params.
function QuickHTTPSGet(sURL: ansistring; out sOutREsponse: string;
addHead: string =''; addHeadValue: string = ''): boolean;
var
htp: IXMLhttprequest;
begin
htp := ComsXMLHTTP30.create();
try
htp.open('GET', sURL, false, null, null);
if addHead <> '' then
htp.setRequestHeader(addHead, addHeadValue);
htp.send('');
result := htp.status = 200;
if result then
sOutREsponse := htp.responsetext
else
soutResponse := 'error '+inttostr(htp.status);
except
on e: Exception do begin
result := false;
sOutResponse := 'error '+e.message;
end;
end;
end;
I am new to Delphi and trying to convert vb.net apps to learn. The issue I am having is reading from a TCP/IP host. Currently I can connect via telnet to the device, send a command, and the device will send data non-stop until all data is sent. This could be simply two characters followed by CR/LF, or it could be several rows of varing length data. Each row is end is CR/LF. Prior to writing code, we were able to telnet via Hyperterminal to the device. Send a command, and, with the capture text enabled save to a text file.
Below is the code I have so far. I have not coded for saving to text file (one step at a time). The data is pipe delimited. I have no control on the format or operatation of the device aside from sending commands and receiving data. It works most of the time however there are times when not all of the data (65 records for testing) are received. I will greatly appreciate guidence and feel free to comment on my code, good or bad.
function Parse(Char, S: string; Count: Integer): string;
var
I: Integer;
T: string;
begin
if S[Length(S)] <> Char then
S := S + Char;
for I := 1 to Count do
begin
T := Copy(S, 0, Pos(Char, S) - 1);
S := Copy(S, Pos(Char, S) + 1, Length(S));
end;
Result := T;
end;
procedure TForm2.btnEXITClick(Sender: TObject);
begin
if idTcpClient1.connected then
begin
idTcpClient1.IOHandler.InputBuffer.clear;
idTcpClient1.Disconnect;
end;
Close;
end;
procedure TForm2.btnSendDataClick(Sender: TObject);
var
mTXDataString : String;
RXString : String;
begin
IdTCPClient1.Host := IPAddress.Text;
IdTCPClient1.Port := StrToInt(IPPort.Text);
mTXDataString := mTXData.Text + #13#10;
IdTCPClient1.Connect;
If IdTCPClient1.Connected then
begin
IdTCPClient1.IOHandler.Write(mTXDataString);
mTXDataString := mTXData.Lines.Text;
if MTXDataString.Contains('SCHEMA') then
begin
mRXData.Lines.Add(IdTCPClient1.IOHandler.ReadLn);
while not (IdTCPClient1.IOHandler.InputBufferIsEmpty) do
begin
RXString := IdTCPClient1.IOHandler.ReadLn;
If (RXString <> '') and (RXString <> '??') then
begin
//Add received data to RXmemo
mRXData.Lines.Add(RXString);
//Determine number of records to received based on schema data
lblRecords.Caption := Parse(',', RXString, 2);
end;
end; //while not
end // if
else
if mTXDataString.Contains('DATA') then
begin
mRXData.Lines.Add(IdTCPClient1.IOHandler.ReadLn);
while not (IdTCPClient1.IOHandler.InputBufferIsEmpty) do
begin
RXString := IdTCPClient1.IOHandler.ReadLn;
If (RXString <> '') and (RXString <> '??') then
begin
mRXData.Lines.Add(RXString);
end; // if
end; //while not
end; // if Schema or not
end; // if Connected
IdTCPClient1.Disconnect;
end; //Procedure
HyperTerminal and Telnet apps display whatever data they receive, in real-time. TIdTCPClient is not a real-time component. You control when and how it reads. If you are expecting data to arrive asynchronously, especially if you don't know how many rows are going to be received, then you need to perform the reading in a timer or worker thread, eg:
procedure TForm2.TimerElapsed(Sender: TObject);
var
S: String;
begin
if IdTCPClient1.IOHandler = nil then Exit;
if IdTCPClient1.IOHandler.InputBufferIsEmpty then
begin
IdTCPClient1.IOHandler.CheckForDataOnSource(50);
if IdTCPClient1.IOHandler.InputBufferIsEmpty then Exit;
end;
S := IdTCPClient1.IOHandler.ReadLn;
// use S as needed ...
end;
Or:
type
TMyThread = class(TThread)
protected
fClient: TIdTCPClient;
procedure Execute; override;
public
constructor Create(aClient: TIdTCPClient);
end;
constructor TMyThread.Create(aClient: TIdTCPClient);
begin
inherited Create(False);
fClient := aClient;
end;
procedure TMyThread.Execute;
var
S: String;
begin
while not Terminated do
begin
S := fClient.IOHandler.ReadLn;
// use S as needed ...
end;
end;
Or, if the server supports the actual Telnet protocol, have a look at using Indy's TIdTelnet component instead.
I use the following code to eval the msg. content (body / lines) of an E Mail msg received with the INDY 10 components
function LinesFromMsg(aMsg: TIdMessage): TStrings;
var
i: Integer;
begin
for i := 0 to aMsg.MessageParts.AttachmentCount-1 do
begin
if (amsg.MessageParts.Items[i].ContentType ='HTML') then
begin
if (amsg.MessageParts.Items[i] is Tidtext) then
Result := TidText(amsg.MessageParts.Items[i]).body;
end;
end;
end;
regarding this code I have 2 questions :
a) is this the correct way of finding the Tlines part in an arbitray mail message ?
( consider the advice shown at INDY 10 EMAIL MSG PARTS )
b) where can I find a tutorial of all the different Contenttype string values?
The correct ContentType value to look for is text/html. Use Indy's IsHeaderMediaType() function to check it, as the ContentType value may have additional attributes associated with it that your comparison needs to ignore.
You also need to take the TIdMessage.ContentType into account as well, as HTML emails may not be MIME encoded and thus not use the TIdMessage.MessageParts` collection at all.
And lastly, you loop needs to use the MessageParts.Count property instead of the MessageParts.AttachmentsCount property.
Try this:
function HTMLFromMsg(aMsg: TIdMessage): TStrings;
var
i: Integer;
Part: TIdMessagePart;
begin
Result := nil;
if IsHeaderMediaType(aMsg.ContentType, 'text/html') then
begin
Result := aMsg.Body;
Exit;
end;
for i := 0 to aMsg.MessageParts.Count-1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part is TIdText) and IsHeaderMediaType(Part.ContentType, 'text/html') then
begin
Result := TIdText(Part).Body;
Exit;
end;
end;
end;
With that said, this is technically not the correct way to handle MIME. Officially, a conforming reader is supposed to loop backwards through the MIME parts, as they are ordered from the simpliest form downwards towards the most complex form. So you loop backwards, taking MIME nesting into account, looking for the most complex form you support. Something more like this (untested):
procedure DisplayPlainText(Body: TStrings);
begin
// display plain text as needed...
end;
procedure DisplayHTML(Body: TStrings);
begin
// display html as needed...
end;
procedure DisplayMultiPartAlternative(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);
var
Part: TIdMessagePart;
i: Integer:
begin
for i := aLastIndex-1 downto aParentIndex+1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part.ParentPart = aParentIndex) and (Part is TIdText) then
begin
if IsHeaderMediaType(Part.ContentType, 'text/html') then
begin
DisplayHTML(TIdText(Part).Body);
Exit;
end;
if IsHeaderMediaType(Part.ContentType, 'text/plain') then
begin
DisplayPlainText(TIdText(Part).Body);
Exit;
end;
end;
end;
// nothing supported to display...
end;
procedure DisplayMultiPartMixed(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);
var
Part: TIdMessagePart;
i: Integer;
begin
for i := aLastIndex-1 downto aParentIndex+1 do
begin
Part := aMsg.MessageParts.Items[i];
if (Part.ParentPart = aParentIndex) and (Part is TIdText) then
begin
if IsHeaderMediaType(Part.ContentType, 'multipart/alternative') then
begin
DisplayMultiPartAlternative(aMsg, ParentPart.Index, aLastIndex);
Exit;
end;
if IsHeaderMediaType(ParentPart.ContentType, 'text/html') then
begin
DisplayHTML(TIdText(Part).Body);
Exit;
end;
if IsHeaderMediaType(Part.ContentType, 'text/plain') then
begin
DisplayPlainText(TIdText(Part).Body);
Exit;
end;
aLastIndex := i;
end;
end;
// nothing supported to display...
end;
procedure DisplayMsg(aMsg: TIdMessage);
var
ContentType: string;
begin
ContentType := ExtractHeaderMediaType(aMsg.ContentType);
case PosInStrArray(ContentType, ['multipart/mixed', 'multipart/alternative', 'text/html', 'text/plain'], False) of
0: begin
DisplayMultiPartAlternative(aMsg, -1, aMsg.MessageParts.Count);
Exit;
end;
1: begin
DisplayMultiPartMixed(aMsg, -1, aMsg.MessageParts.Count);
Exit;
end;
2: begin
DisplayHTML(aMsg.Body);
Exit;
end;
3: begin
DisplayPlainText(aMsg.Body);
Exit;
end;
else
// nothing supported to display...
end;
end;
I want to display a treeview with all the registry information in it ( i.e all the subkeys ). I have put together the following Fn to do the same. But i am getting the info of only one Key, not all. What is missing in my code ?
function TForm1.DisplayKeys(TreeNode : TTreeNode;KeyToSearch:String):String;
var
i: Integer;
RootKey : Integer;
NewTreeNode : TTreeNode;
str : TStringList;
// str2: TStringList;
begin
i:=0;
if reg.OpenKey(KeyToSearch,False) then
begin
str:=nil;
str:=TStringList.create;
reg.GetKeyNames(str);
//For all SubKeys
for i:=0 to str.Count-1 do
begin
NewTreeNode:=TreeView1.Items.AddChild(TreeNode, Str.Strings[i]);
if reg.HasSubKeys then
begin
DisplayKeys(NewTreeNode,Str.Strings[i]);
end;
end;
end;
the call to the Function is
procedure TForm1.FormCreate(Sender: TObject);
begin
reg:=nil;
reg:=TRegistry.create;
str2:=nil;
str2:=TStringList.create;
reg.RootKey:=HKEY_CURRENT_CONFIG;
TreeView1.Items.BeginUpdate; //prevents screen repaint every time node is added
DisplayKeys(nil,''); // call to fn here
TreeView1.Items.EndUpdate; // Nodes now have valid indexes
end;
Note that i am not getting any error, just that info is incomplete
Some problems:
You are using OpenKey which attempts to open the key with write access. Instead you should use OpenKeyReadOnly. If you really do mean to write to those keys then you will have to run elevated as an administrator.
You are failing to close the keys once you have finished with them.
More seriously, your use of relative registry keys is not sufficient. I believe you will need to pass around the full path to the key. I wrote a little demo console app to show what I mean:
program RegistryEnumerator;
{$APPTYPE CONSOLE}
uses
Classes, Windows, Registry;
var
Registry: TRegistry;
procedure DisplayKeys(const Key: string; const Depth: Integer);
var
i: Integer;
SubKeys: TStringList;
begin
if Registry.OpenKeyReadOnly(Key) then begin
Try
SubKeys := TStringList.Create;
Try
Registry.GetKeyNames(SubKeys);
for i := 0 to SubKeys.Count-1 do begin
Writeln(StringOfChar(' ', Depth*2) + SubKeys[i]);
DisplayKeys(Key + '\' + SubKeys[i], Depth+1);
end;
Finally
SubKeys.Free;
End;
Finally
Registry.CloseKey;
End;
end;
end;
begin
Registry := TRegistry.Create;
Try
Registry.RootKey := HKEY_CURRENT_CONFIG;
DisplayKeys('', 0);
Readln;
Finally
Registry.Free;
End;
end.
try this :-
procedure TForm1.Button1Click(Sender: TObject);
begin
TreeView1.Items.Clear;
path := Edit1.Text;
// reg.RootKey := HKEY_LOCAL_MACHINE ;
TreeView1.Items.BeginUpdate;
drawtreeview(nil, path);
TreeView1.Items.EndUpdate;
end;
procedure TForm1.drawtreeview( node: TTreeNode; name: string);
var
i: Integer;
NewTreeNode: TTreeNode;
str, str2 : TStringList;
reg : TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
i := 0;
if reg.OpenKeyReadOnly(name) then
begin
str := TStringList.create;
reg.GetKeyNames(str);
for i := 0 to str.Count - 1 do
begin
NewTreeNode := TreeView1.Items.AddChild(node, str.Strings[i]);
if reg.HasSubKeys then
begin
drawtreeview(NewTreeNode, name + '\' + str.Strings[i]);
end
else
ShowMessage('no sub keys');
end;
end;
reg.CloseKey;
reg.Free;
end;