My question was asked here before, but I'm trying to implement a neater solution for my project. So, as title states, I'm creating a complex installer of the server application that has to check local IP address and choose a open port, so that the application could be properly configured. Inno Setup 5.6.1 is used.
Getting local IP addresses was not a problem, this solution helped me a lot. Then it came to the port's checking and here I've found the following three options:
Using external DLL from installer. Actually, previous solution consisted of a C++ DLL, that exported two exact convenience functions, they worked great, installer used them, but sometimes, rarely on some Windows versions this DLL didn't want to get loaded causing error. That's why all the more messing with Pascal Script here.
Launching netstat via cmd and getting the output. This is still an option, though I feel this solution is crutchy like hell and would like to avoid it. Details could be found in other SO answer.
Getting information from WinAPI call. Looks best if possible.
As was mentioned above, getting IP address can be implemented via straightforward (ok, not really, it's a Pascal Script) WinAPI calls. So, I tried to do the same trick with ports, trying to call GetTcpTable():
[Code]
const
ERROR_INSUFFICIENT_BUFFER = 122;
function GetTcpTable(pTcpTable: Array of Byte; var pdwSize: Cardinal;
bOrder: WordBool): DWORD;
external 'GetTcpTable#IpHlpApi.dll stdcall';
{ ------------------------ }
function CheckPortIsOpen(port: Integer): Boolean;
var
TableSize : Cardinal;
Buffer : Array of Byte; { Alas, no pointers here }
RecordCount : Integer;
i, j : Integer;
portNumber : Cardinal;
IpAddr : String;
begin
Result := True;
TableSize := 0;
if GetTcpTable(Buffer, TableSize, False) = ERROR_INSUFFICIENT_BUFFER then
begin
SetLength(Buffer, TableSize);
if GetTcpTable(Buffer, TableSize, True) = 0 then
begin
{ some magic calculation from GetIpAddrTable calling example }
RecordCount := (Buffer[1] * 256) + Buffer[0];
For i := 0 to RecordCount -1 do
begin
portNumber := Buffer[i*20 + 8]; { Should work! }
{ Debugging code here }
if (i < 5) then begin
IpAddr := '';
For J := 0 to 3 do
begin
if J > 0 then
IpAddr := IpAddr + '_';
IpAddr := IpAddr + IntToStr(Buffer[I*20+ 4 + J]);
end;
SuppressibleMsgBox(IpAddr, mbError, MB_OK, MB_OK);
end;
{ ------ }
if port = portNumber then
Result := False;
end;
end;
end;
end;
This GetTcpTable also returns information about addresses and ports (table of TCP connections to be exact), so trying to get any connection address is good for debugging purposes. More about this attempt:
RecordCount is calculated the same way as in the code I used as an example, because obtained struct there is very similar to the nasty struct I need.
That i*20 + 8 is written that way, because 20 = sizeof(single record struct) and 8 = 2 * sizeof(DWORD). Local TCP connection address is being "parsed" one-by-one-byte at an offset of 1 DWORD, as you can see.
So, everything is great fun... it just is not working =((
And yes, I've tried to print all the bytes one-by-one, to search for the desired data manually and understand the correct offset. To my disappointment, nothing looking like IPs and ports was found, the numbers were quite mysterious.
I know that sometimes the simplest solution is best, not the smartest, but if anyone could give me a key cooking this WinAPI function in a proper way, I would be deeply grateful.
Your magic calculations are off.
portNumber := Buffer[i*20 + 8]; { Should work! }
Since Buffer is a byte array the above extracts one byte only. But the local port number is a DWORD in the TCP table. Though the documentation you linked states:
The local port number in network byte order for the TCP connection on the local computer.
The maximum size of an IP port number is 16 bits, so only the lower 16 bits should be used. The upper 16 bits may contain uninitialized data.
So we need two bytes. And we need to switch them, note "network byte order" above.
You are also forgetting to account for the 4 byte record count at the beginning of the table. So the local port number should become:
portNumber := Buffer[i*20 + 12] * 256 +
Buffer[i*20 + 13];
Related
I get the following when communicating with a custom client.
With custom client i mean a housemade PCB with a FPGA which runs the Triple-Speed Ethernet Intel FPGA IP. It does not make a difference if a switch is between the PC and the PCB.
Workflow seen from the Server(Windows PC) where i detect this behaviour with wireshark:
Connect to client (Syn - Syn/Ack - Ack) Winsock2.connect
Sending data > MTU with Winsock2.WSASend (4092 Bytes on a 4088 Bytes MTU)
Packet gets "fragmented" into 2 packets - do not fragment bit is set
A Retransmission happens (because the client answered too slow?)
I am using delphi 10.4 and use the Winsock2 functions. Bevore each send i check with select if fdwrite is set if FD_Isset. Nagle is deactivated.
The "retransmission" does not happen everytime and i could not detect any sort of pattern when they occur. Except most of the time it is when the client needs more than 30ms to send his ACK.
When the "retransmission" happens it is not packet 1 or two whicht is re-send, but packet 1 with an offset of 60 which is the payload of packet 2. The sequence number of packet 1 is incremented by 60 too. Even the data is correct, it's correctly incremented by 60.
When I send 6000 Bytes i get the same behaviour with an incremented seq of 1968 which is correct too.
What is happening here?
Can i detect this with winsock2? Can i set the RTO with winsock? Why is the sequence number incremented and not packet 1, as it is, retransmitted?
Source Code of the send function:
function TZWinTCPSock.SendData (out ErrMsg : TAPILogStruct; SendOffset :
Cardinal = 0) : Boolean;
var
WSABuff : WSABUF;
res : Integer;
IPFlags : Cardinal;
t : Cardinal;
WSAErr : Cardinal;
begin
Result := FALSE;
WSAErr := WSAGetLastError;
try
if not CheckSockValid(ErrMsg) then // checks if fd_write is set
begin
exit(false);
end;
try
WSABuff.len := FMem.SendLength; // 4092 at this time Cardinal
WSABuff.buf := #FMem.SendData[SendOffset]; // 8192 Bytes reserved TArray<Byte>
IPFlags := 0;
res := WSASend(FSocket,#WSABuff,1,FMem.sentBytes,IPFlags,nil,nil);
if Res <> SOCKET_ERROR then
begin
if FMem.SendLength <> FMem.SentBytes then
begin
exit(false);
end
else
begin
Result := TRUE;
if WSAGetLastError <> WSAErr then // unexpected WSA error
begin
exit(FALSE);
end;
end;
end
else
begin
FLastWSAErr := WSAGetLastError;
if FLastWSAErr = WSAECONNRESET then
begin
Disconnect(ErrMsg);
exit(false);
end;
end;
except
on E : Exception do
begin
// Some error handling
end;
end;
finally
end;
end;
Edit1
The packets have the don't fragment Bit set.
I tried to detect this "retransmission" with the windows admin center, but I don't see anything popping up.
Got an answer on Microsoft Q&A.
Looks like it was a tail loss probe problem where the destination host is at fault, because the reply took too long and srtt timed out.
Using Delphi (windows app) i want to get list of other applications running currently. Here How to check if a process is running using Delphi? i've found great tutorial about geting filenames/names of running application, however it gives names only process name (for example NOTEPAD.EXE). I've used naturally part with
UpperCase(ExtractFileName(FProcessEntry32.szExeFile))
and
UpperCase(ExtractFilePath(FProcessEntry32.szExeFile))
and just
UpperCase(FProcessEntry32.szExeFile)
but obviously FProcessEntry32.szExeFile does not have a path to file/process
Is there a simply way of getting list with paths? Here's How to get the list of running processes including full file path? solution with JclSysInfo library, but i cant use it in place of work in project.
I looked at what I could in Google and what I found usually concerned just the application that is running or the application that is active, but I can't just find a list of all running applications. Maybe i'm missing something obvious?
I'm not looking for any complex procedures, I'm not much interested in process parrent, or if there is no access to the process path, I don't have it and don't bother.
Any simple hint?
OK, due to helpfull comment from #TLama i've combined topics above to take name and path of process:
function processExists(exeFileName: string): Boolean;
var
ContinueLoopP, ContinueLoopM: BOOL;
FSnapshotHandle1, FSnapshotHandle2: THandle;
FProcessEntry32: TProcessEntry32;
FMODULEENTRY32: TMODULEENTRY32;
begin
FSnapshotHandle1 := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
FMODULEENTRY32.dwSize := SizeOf(FMODULEENTRY32);
ContinueLoopP := Process32First(FSnapshotHandle1, FProcessEntry32);
ContinueLoopM := Module32First(FSnapshotHandle2, FMODULEENTRY32);
Result := False;
while Integer(ContinueLoopP) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := True;
ShowMessage(FMODULEENTRY32.szExePath + FProcessEntry32.szExeFile);
ContinueLoopP := Process32Next(FSnapshotHandle1, FProcessEntry32);
ContinueLoopM := Module32Next(FSnapshotHandle2, FMODULEENTRY32);
end;
CloseHandle(FSnapshotHandle1);
CloseHandle(FSnapshotHandle2);
end;
But still FProcessEntry32.szExeFile returns empty string. What i'm doing wrong? Thank You in advance.
I cannot write comment (low score), so I need to write as "answer". Try this code,
using FProcessEntry32.th32ProcessID as parameter:
Function QueryFullProcessImageNameW(hProcess:THandle; dwFlags:Cardinal; lpExeName:PWideChar; Var lpdwSize:Cardinal) : Boolean; StdCall; External 'Kernel32.dll' Name 'QueryFullProcessImageNameW';
Function GetFullPath(Pid:Cardinal) : UnicodeString;
Var rLength:Cardinal;
Handle:THandle;
Begin Result:='';
Handle:=OpenProcess(PROCESS_QUERY_INFORMATION, False, Pid);
If Handle = INVALID_HANDLE_VALUE Then Exit;
rLength:=256; // allocation buffer
SetLength(Result, rLength+1); // for trailing space
If Not QueryFullProcessImageNameW(Handle, 0, #Result[1],rLength) Then Result:='' Else SetLength(Result, rLength);
End;
This is a simple way I think. If you want to get the loaded DLL's full name, use
FMODULEENTRY32.hModule with GetModuleFileNameW function.
I am trying to write a detailed error message to the system log using the ReportEventW function. Unfortunately, I am encountering problems which are apparently related to the limits within the function but I can't find any real documentation of them: there is a documented limit on dwDataSize and another limit on the maximum length of each string. I am not violating any of these limits, but I am still receiving a FALSE and GetLastError reports RPC_S_INVALID_BOUND.
Through testing, I found that for my test case the limit is caused by the number of strings (wNumStrings), with 203 being the most I can put through correctly (additionally, for 204-206 strings the ReportEventW will return a TRUE but will not write to the log!). If I add 1024 dummy characters to the first line, I once again get an error and have to decrease the number of lines, as far as I can tell, by the same number of characters I added earlier, which would indicate that some total character limit on the whole message is coming to play. Unfortunately, I can't match it against any documented limit even if I ignore what the limits should apply to - my value of about 33300 characters is close to the value 31839 characters (max. length of each string), but sufficiently higher than that to make me discard the theory that the limit on a length of individual string also applies to the total length of the whole message. Apparently, if I add extra raw data, the limit goes down again, which suggests a limitation on the size of the whole event log record.
My questions are:
1) Does anyone know the actual limits for writing to the event log?
2) Do these limits change with the different operating systems? All my tests were performed on Win10 x64, but I have a nasty suspicion that with different OSes, I will encounter a different limitation.
3) Is this documented somewhere?
Thanks.
Actual code (added on request)
procedure WriteToEventLog(const Messages: array of string; const RawData: AnsiString);
const
MaxStringCount = High(Word); // je to WORD! Realne se limit zda byt mnohem mensi
MaxRawDataLen = 61440;
EmptyMessage = #0#0#0#0;
type
TPCharArray = array[0..65535] of PChar;
var
Handle: THandle;
Msgs: ^TPCharArray;
MsgCount: integer;
DataPtr: PAnsiChar;
DataLen: integer;
i: Integer;
begin
MsgCount := Length(Messages);
if MsgCount > MaxStringCount then
MsgCount := MaxStringCount;
Msgs := AllocMem(MsgCount * Sizeof(PChar));
try
for i := 0 to Pred(MsgCount) do
begin
if Messages[i] = ''
then Msgs[i] := EmptyMessage
else Msgs[i] := PChar(Messages[i]);
end;
if RawData = '' then
begin
DataPtr := nil;
DataLen := 0;
end
else
begin
DataPtr := #RawData[1];
DataLen := Length(RawData);
if DataLen > MaxRawDataLen then
DataLen := MaxRawDataLen;
end;
Handle := RegisterEventSource(nil, PChar(ParamStr(0)));
if Handle <> 0 then
begin
try
ReportEvent(Handle, EVENTLOG_ERROR_TYPE, 0, 0, nil, MsgCount, DataLen, Msgs, DataPtr);
finally
DeregisterEventSource(Handle);
end;
end;
finally
FreeMem(Msgs);
end;
end;
It is called with Messages array containing rows from an EurekaLog report (one row per message, about 300 rows).
I can't answer your questions comprehensively, but I just ran into a similar issue. I only used the wNumStrings and lpStrings parameters and, contrary to documentation, still received the RPC_S_INVALID_BOUND error code (1734). On a nagging suspicion, I reduced the number of strings to 256 and it worked. Sure enough, it failed with 257. This was true regardless of the size of the individual strings. There are probably upper limits for individual strings and total message size too, but I didn't bother figuring those out.
TL/DR: wNumStrings <= 256
I am trying to port some xor-encryption code so it doesn't use any other units. I want to use just the commands, variables, and types that are supported natively by the compiler.
For example, here's some of the original code:
[...]
while (StreamIn.Position < StreamIn.Size) and
((StreamIn.Size -StreamIn.Position) >= szBuffer) do begin
(* read 4 bytes at a time into a local integer variable *)
StreamIn.ReadBuffer(buffer, szBuffer);
(* the XOR encryption/decryption *)
buffer := buffer xor theKey;
buffer := buffer xor $E0F;
(* write data to output stream *)
StreamOut.WriteBuffer(buffer, szBuffer);
end;
[...]
This is my code:
function __NativeEncrypt (const Key, Source : String) : String;
// this function should not be used directly
// use EncryptText and DecryptText
const
szBuffer = SizeOf(Integer); (* 4 bytes *)
szByteBuffer = SizeOf(Byte); (* 1 byte *)
var
byteBuffer,
buffer,
index,
theKey: Integer;
StreamIn : String;
StreamOut : String;
i : Integer;
begin
theKey := hashKey(Key);
StreamIn := Source;
StreamOut := '';
for i := 1 to Length (StreamIn) do begin
buffer := Integer(StreamIn[i]);
buffer := buffer xor thekey;
buffer := buffer xor $E0F;
StreamOut := StreamOut + char(Buffer);
end;
result := StreamOut; // wrong results.
// to continue...
end;
What tips are there for this task?
The only reason not to use library-provided units is as a learning exercise. I see no other reason to intentionally cripple yourself by refusing to use built-in features of your tools. Any answer to your general request for tips would rob you of the learning experience.
Most developers end up rewriting something from scratch at some point in their careers. However, unless it was imposed by a supervisor who suffers from extreme not-invested-here syndrome, it's nearly always a personal experience. You won't profit from their experience the same way you will from doing the work yourself. Doing it yourself will give you an understanding of what jobs the built-in tools do, and may give you some insight into why they're designed the way they are. Although you might be able to get those explanations from other people, unless you've actually tried to do it yourself, you won't really appreciate the explanations anyway.
My tip to you is to proceed with your project. I hope you find it interesting, and I wish you luck. If you eventually find yourself unable to make further progress, then identify the specific problem you're stuck on, and then ask others for help with that roadblock.
I want to download a file from Internet and InternetReadFile seem a good and easy solution at the first glance. Actually, too good to be true. Indeed, digging a bit I have started to see that actually there are a lot of issues with it. People are complaining about all kinds of problems when using this code.
Problems could appear because:
the application freezes temporarily until the HTTP server responds
the application freezes temporarily because the Internet connections breaks
the application locks up because the HTTP server never responds
the InternetOpen (I just discovered this recently) MUST be called only once during application life time
I could not find a complete example about how to use it properly and robustly. Does anybody have an idea about how to implement it in a separate thread and with a time out? There is another SIMPLE way to robustly download a file from Internet. Though I don't want to complicate my life with very large libraries like Jedi or even Indy.
function GetFileHTTP (const fileURL, FileName: String): boolean;
CONST
BufferSize = 1024;
VAR
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: File;
sAppName: string;
begin
// result := false;
sAppName := ExtractFileName(Application.ExeName) ;
hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ; { be aware that InternetOpen need only be called once in your application!!!!!!!!!!!!!! }
TRY
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0) ;
TRY
AssignFile(f, FileName) ;
Rewrite(f, 1) ;
REPEAT
InternetReadFile(hURL, #Buffer, SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen)
UNTIL BufferLen = 0;
CloseFile(f) ;
Result:= True;
FINALLY
InternetCloseHandle(hURL)
end
FINALLY
InternetCloseHandle(hSession)
END;
END;
Edit:
This functions checks if Internet connection is available. It seems to work on Win98 also.
{ Are we connected to the Internet? }
function IsConnectedToInternet: Boolean; { Call SHELL32.DLL for Win < Win98 otherwise call URL.dll }
var InetIsOffline: function(dwFlags: DWORD): BOOL; stdcall;
begin
Result:= FALSE;
if IsApiFunctionAvailable('URL.DLL', 'InetIsOffline', #InetIsOffline)
then Result:= NOT InetIsOffLine(0)
else
if IsApiFunctionAvailable('SHELL32.DLL', 'InetIsOffline', #InetIsOffline)
then Result:= NOT InetIsOffLine(0)
end;
I am using Delphi 7. Many thanks.
Edit:
Losing customers because the application hangs at the first start up is the perfect recipe for losing money.
Writing your code to be Microsoft platform dependent is bad. You never know if the customer has the IE version x.x installed.
Installing stuff into a user's computer is like playing with guns. It will backfire.
(see more about this here: http://thesunstroke.blogspot.com/2010/06/programmig-like-there-is-no-ms-windows.html)
I basically do the same as you do. For me it works fairly flawlessly.
The only differences between my code and your code is I have an INTERNET_FLAG_RELOAD parameter to force a download from the file and not the cache. You can try that and see if it works better:
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, INTERNET_FLAG_RELOAD, 0) ;
Also check for an internet connection before downloading. Do this:
dwConnectionTypes := INTERNET_CONNECTION_MODEM
+ INTERNET_CONNECTION_LAN
+ INTERNET_CONNECTION_PROXY;
InternetConnected := InternetGetConnectedState(#dwConnectionTypes, 0);
if InternetConnected then ...
Here's some sample code that uses Indy. This code is for Delphi 2010 (with Indy 10?), but the code for Delphi 7 would be similar. I've used Indy for years with D7 and have been very happy with it. I think in D7 we use Indy 9. Check if you need to download a new version...
You can use OnWork and OnWorkBegin to add a progress meter if you need to.
This code I excerpted from a bigger piece, editing it a bit. I did not try compiling it, but it will give you a good starting place.
function Download( const aSourceURL: String;
const aDestFileName: String;
out aDownloadResult: TDownloadResult;
out aErrm: String): boolean;
var
Stream: TMemoryStream;
IDAntiFreeze: TIDAntiFreeze;
begin
aDownloadResult := DROther;
Result := FALSE;
fIDHTTP := TIDHTTP.Create;
fIDHTTP.HandleRedirects := TRUE;
fIDHTTP.AllowCookies := FALSE;
fIDHTTP.Request.UserAgent := 'Mozilla/4.0';
fIDHTTP.Request.Connection := 'Keep-Alive';
fIDHTTP.Request.ProxyConnection := 'Keep-Alive';
fIDHTTP.Request.CacheControl := 'no-cache';
IDAntiFreeze := TIDAntiFreeze.Create;
Stream := TMemoryStream.Create;
try
try
fIDHTTP.Get(aSourceURL, Stream);
if FileExists(aDestFileName) then
DeleteFile(PWideChar(aDestFileName));
Stream.SaveToFile(aDestFileName);
Result := TRUE;
aDownloadResult :=drSuccess;
except
On E: Exception do
begin
Result := FALSE;
aErrm := E.Message + ' (' + IntToStr(fIDHTTP.ResponseCode) + ')';
end;
end;
finally
Stream.Free;
IDAntiFreeze.Free;
fIDHTTP.Free;
end;
end; { Download }
My personal favorite is using the WebHttpRequest component from importing the "Microsoft WinHTTP Services" type library: http://yoy.be/item.asp?i142
var
w:IWebHttpRequest;
f:TFileStream;
os:TOleStream;
begin
w:=CoWebHttpRequest.Create;
w.Open('GET',SourceURL,false);
w.Send(EmptyParam);
os:=TOleStream.Create(IUnknown(w.ResponseStream) as IStream);
f:=TFileStream.Create(DestinationFilePath,fmCreate);
os.Position:=0;
f.CopyFrom(os,os.Size);
f.Free;
os.Free;
w:=nil;
end;
I recommend Synapse. It's small, stable and easy-to-use (no need of any external libraries).
Example from httpsend.pas
function HttpGetText(const URL: string; const Response: TStrings): Boolean;
var
HTTP: THTTPSend;
begin
HTTP := THTTPSend.Create;
try
Result := HTTP.HTTPMethod('GET', URL);
if Result then
Response.LoadFromStream(HTTP.Document);
finally
HTTP.Free;
end;
end;
Instead of fiddling with the WinAPI, the ExtActns unit provides just what you need for downloading to a file.
procedure TMainForm.DownloadFile(URL: string; Dest: string);
var
dl: TDownloadURL;
begin
dl := TDownloadURL.Create(self);
try
dl.URL := URL;
dl.FileName := Dest;
dl.ExecuteTarget(nil); //this downloads the file
dl.Free;
except
dl.Free;
end;
end;
Under the hood, it uses URLDownloadToFile from the URLMon library - which is part of IE, and therefore part of Windows.
TDownloadURL doesn't handle any timeout for you - it doesn't look like such a thing is supported in URLMon at all, although there could be some default timeout that causes the call to fail - but you could use the OnProgress event on TDownloadURL to get notified when something happens, and then do something in another thread if it's been too long since the last callback.
Solved using improved version of the above code.
(it still does not solve all issues - MS does not actually implemented full support for server time out)
The connection does not timeout while downloading file from internet