Subversion Repositories userdetect2

Compare Revisions

No changes between revisions

Regard whitespace Rev 99 → Rev 100

/trunk/UserDetect2/UD2_Utils.pas
47,10 → 47,10
implementation
 
uses
idhttp, Forms;
wininet, Forms;
 
function SplitString(const aSeparator, aString: string; aMax: Integer = 0): TArrayOfString;
// http://stackoverflow.com/a/2626991/3544341
// https://stackoverflow.com/a/2626991/3544341
var
i, strt, cnt: Integer;
sepLen: Integer;
139,7 → 139,7
end;
 
function ExpandEnvStr(const szInput: string): string;
// http://stackoverflow.com/a/2833147/3544341
// https://stackoverflow.com/a/2833147/3544341
const
MAXSIZE = 32768;
begin
196,12 → 196,12
end;
 
procedure UD2_RunCMD(cmd: TUD2Command);
// Discussion: http://stackoverflow.com/questions/32802679/acceptable-replacement-for-winexec/32804669#32804669
// Version 1: http://pastebin.com/xQjDmyVe
// Discussion: https://stackoverflow.com/questions/32802679/acceptable-replacement-for-winexec/32804669#32804669
// Version 1: https://pastebin.com/xQjDmyVe
// --> CreateProcess + ShellExecuteEx
// --> Problem: Run-In-Same-Directory functionality is not possible
// (requires manual command and argument separation)
// Version 2: http://pastebin.com/YpUmF5rd
// Version 2: https://pastebin.com/YpUmF5rd
// --> Splits command and arguments manually, and uses ShellExecute
// --> Problem: error handling wrong
// --> Problem: Run-In-Same-Directory functionality is not implemented
290,6 → 290,7
{$ENDIF}
end;
 
(*
function GetHTML(const url: string): string;
var
idhttp :Tidhttp;
301,7 → 302,87
idhttp.Free;
end;
end;
*)
// https://www.delphipraxis.net/post43515.html , fixed , works for Delphi 12 Athens
function GetHTML(AUrl: string): RawByteString;
var
databuffer : array[0..4095] of ansichar; // SIC! ansichar!
ResStr : ansistring; // SIC! ansistring
hSession, hfile: hInternet;
dwindex,dwcodelen,dwread,dwNumber: cardinal;
dwcode : array[1..20] of char;
res : pchar;
Str : pansichar; // SIC! pansichar
begin
ResStr:='';
if (system.pos('http://',lowercase(AUrl))=0) and
(system.pos('https://',lowercase(AUrl))=0) then
AUrl:='http://'+AUrl;
 
// Hinzugefügt
if Assigned(Application) then Application.ProcessMessages;
 
hSession:=InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,
nil,
nil,
0);
if assigned(hsession) then
begin
// Hinzugefügt
if Assigned(Application) then application.ProcessMessages;
 
hfile:=InternetOpenUrl(
hsession,
pchar(AUrl),
nil,
0,
INTERNET_FLAG_RELOAD,
0);
dwIndex := 0;
dwCodeLen := 10;
 
// Hinzugefügt
if Assigned(Application) then application.ProcessMessages;
 
HttpQueryInfo(hfile,
HTTP_QUERY_STATUS_CODE,
@dwcode,
dwcodeLen,
dwIndex);
res := pchar(@dwcode);
dwNumber := sizeof(databuffer)-1;
if (res ='200') or (res = '302') then
begin
while (InternetReadfile(hfile,
@databuffer,
dwNumber,
DwRead)) do
begin
 
// Hinzugefügt
if Assigned(Application) then application.ProcessMessages;
 
if dwRead =0 then
break;
databuffer[dwread]:=#0;
Str := pansichar(@databuffer);
resStr := resStr + Str;
end;
end
else
ResStr := 'Status:'+AnsiString(res);
if assigned(hfile) then
InternetCloseHandle(hfile);
end;
 
// Hinzugefügt
if Assigned(Application) then application.ProcessMessages;
 
InternetCloseHandle(hsession);
Result := resStr;
end;
 
procedure VTS_CheckUpdates(VTSID, CurVer: string);
resourcestring
(*
313,9 → 394,9
LNG_NEW_VERSION = 'A new version is available. Do you want to download it now?';
LNG_NO_UPDATE = 'You already have the newest program version.';
var
status: string;
status: RawByteString;
begin
status := GetHTML('http://www.viathinksoft.de/update/?id='+VTSID);
status := GetHTML('https://www.viathinksoft.de/update/?id='+VTSID);
if Copy(status, 0, 7) = 'Status:' then
begin
MessageDlg(LNG_DOWNLOAD_ERR, mtError, [mbOK], 0);
322,11 → 403,11
end
else
begin
if status <> CurVer then
if string(status) <> CurVer then
begin
if MessageDlg(LNG_NEW_VERSION, mtConfirmation, mbYesNoCancel, 0) = ID_YES then
begin
shellexecute(application.handle, 'open', pchar('http://www.viathinksoft.de/update/?id=@'+VTSID), '', '', SW_Normal);
shellexecute(application.handle, 'open', pchar('https://www.viathinksoft.de/update/?id=@'+VTSID), '', '', SW_Normal);
end;
end
else
/trunk/UserDetect2/UserDetect2.dproj
7,7 → 7,7
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.2</ProjectVersion>
<ProjectVersion>19.5</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
18,6 → 18,11
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
29,6 → 34,12
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''">
<Cfg_1_Win64>true</Cfg_1_Win64>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
40,6 → 51,12
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win64)'!=''">
<Cfg_2_Win64>true</Cfg_2_Win64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<SanitizedProjectName>UserDetect2</SanitizedProjectName>
<DCC_N>true</DCC_N>
58,6 → 75,9
<DCC_K>false</DCC_K>
<DCC_F>false</DCC_F>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
70,6 → 90,12
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<VerInfo_Keys>CompanyName=ViaThinkSoft;FileDescription=UserDetect2;FileVersion=2.3.2.0;InternalName=UD2;LegalCopyright=(C) 2015-2017 ViaThinkSoft;LegalTrademarks=;OriginalFilename=UserDetect2.exe;ProductName=UserDetect2;ProductVersion=2.3.2.0;Project leader=Daniel Marschall - www.daniel-marschall.de;Website=www.viathinksoft.de</VerInfo_Keys>
<VerInfo_Release>2</VerInfo_Release>
82,9 → 108,12
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Optimize>false</DCC_Optimize>
93,9 → 122,12
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_MinorVer>2</VerInfo_MinorVer>
<VerInfo_Keys>CompanyName=;FileVersion=2.2.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<AppEnableHighDPI>true</AppEnableHighDPI>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
112,10 → 144,6
<DCCReference Include="UD2_Utils.pas"/>
<DCCReference Include="UD2_PluginStatus.pas"/>
<DCCReference Include="UD2_Parsing.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
123,6 → 151,10
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
135,6 → 167,7
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
/trunk/UserDetect2/UserDetect2.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/trunk/UserDetect2/UserDetect2.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream