Skip to content

Commit

Permalink
Enable update FMD and bunch of fix
Browse files Browse the repository at this point in the history 
Test to update FMD with github release page. Added changelog form,
needed translation.
Bunch of fix to ensure thread safety.
There is still memory leaks, or bad pointer.
  • Loading branch information
@riderkick
riderkick committed Apr 12, 2015
1 parent afa98f2 commit 5407f5a
Show file tree
Hide file tree
Showing 22 changed files with 1,508 additions and 1,218 deletions.
163 changes: 78 additions & 85 deletions baseunits/uBaseUnit.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,9 +13,8 @@
interface

uses
SysUtils, Classes, Graphics, strutils, zstream, fgl,
HTTPSend, Synautil, blcksock, ssl_openssl,
uFMDThread, GZIPUtils;
SysUtils, Classes, Graphics, Forms, strutils, fileinfo, fgl,
uFMDThread, synautil, httpsend, blcksock, ssl_openssl, GZIPUtils;

const
FMD_REVISION = '$WCREV$';
Expand Down Expand Up @@ -238,7 +237,7 @@ interface
TwoDigitYearCenturyWindow :50;
);

SOCKHEARTBEATRATE = 300;
SOCKHEARTBEATRATE = 500;

ANIMEA_ID = 0;
MANGAHERE_ID = 1;
Expand Down Expand Up @@ -331,6 +330,8 @@ interface
MANGASEE_ID = 88;

var
FMD_VERSION_NUMBER: String = '';

Genre: array [0..37] of String;

// cbOptionLetFMDDoItemIndex
Expand Down Expand Up @@ -617,7 +618,7 @@ interface
MANGAHOST_BROWSER: String = '/mangas';

//------------------------------------------
UPDATE_URL: String = 'http://jaist.dl.sourceforge.net/project/fmd/FMD/updates/';
UPDATE_URL: String = 'https://github.com/riderkick/FMD/raw/master/';

OptionAutoCheckMinutes, OptionCustomRename,
// dialog messages
Expand Down Expand Up @@ -736,6 +737,9 @@ TDownloadPageThread = class(TThread)
constructor Create(CreateSuspended: Boolean);
end;

// Get current binary version
function GetCurrentBinVersion: String;
// Remove Unicode
function UnicodeRemove(const S: String): String;
// Check a directory to see if it's empty (return TRUE) or not
function IsDirectoryEmpty(const ADir: String): Boolean;
Expand Down Expand Up @@ -965,6 +969,43 @@ function NTSetPrivilege(sPrivilege: String; bEnabled: Boolean): Boolean;

{$ENDIF}

function GetCurrentBinVersion: String;
var
AppVerInfo: TStringList;
i: Integer;
begin
Result := '';
AppVerInfo := TStringList.Create;
with TFileVersionInfo.Create(nil) do
try
try
FileName := ParamStrUTF8(0);
if FileName = '' then
FileName := Application.ExeName;
{$IF FPC_FULLVERSION >= 20701}
ReadFileInfo;
{$ENDIF}
if VersionStrings.Count > 0 then
begin
{$IF FPC_FULLVERSION >= 20701}
AppVerInfo.Assign(VersionStrings);
{$ELSE}
for i := 0 to VersionStrings.Count - 1 do
AppVerInfo.Add(VersionCategories.Strings[i] + '=' +
VersionStrings.Strings[i]);
{$ENDIF}
for i := 0 to AppVerInfo.Count - 1 do
AppVerInfo.Strings[i] := LowerCase(AppVerInfo.Names[i]) + '=' + AppVerInfo.ValueFromIndex[i];
Result := AppVerInfo.Values['fileversion'];
end;
except
end;
finally
Free;
AppVerInfo.Free;
end;
end;

function UnicodeRemove(const S: String): String;
var
i: Cardinal;
Expand Down Expand Up @@ -2286,6 +2327,17 @@ function GetPage(const AOwner: TObject; const AHTTP: THTTPSend;
HTTP.Free;
end;

function checkTerminate: boolean;
begin
Result := False;
if HTTP.Sock.Tag = 1 then // terminated via OnHeartBeat
begin
Result := True;
HTTP.Sock.Tag := 0;
preTerminate;
end;
end;

label
globReturn;

Expand All @@ -2306,13 +2358,6 @@ function GetPage(const AOwner: TObject; const AHTTP: THTTPSend;

globReturn:

//Site that require HTTPS request should define here
if Pos('https://', URL) <> 0 then
begin
HTTP.Sock.CreateWithSSL(TSSLOpenSSL);
HTTP.Sock.SSLDoConnect;
end;

if ProxyType = 'HTTP' then
begin
HTTP.ProxyHost := Host;
Expand Down Expand Up @@ -2400,14 +2445,7 @@ function GetPage(const AOwner: TObject; const AHTTP: THTTPSend;
(HTTP.ResultCode >= 500) or
(HTTP.ResultCode = 451) do
begin
if (AOwner <> nil) and (AOwner is TFMDThread) then
begin
if TFMDThread(AOwner).IsTerminated then
begin
preTerminate;
Exit;
end;
end;
if checkTerminate then Exit;
if (Reconnect <> 0) and (Reconnect <= counter) then
begin
preTerminate;
Expand All @@ -2427,15 +2465,7 @@ function GetPage(const AOwner: TObject; const AHTTP: THTTPSend;
counter := 0;
while (HTTP.ResultCode = 302) or (HTTP.ResultCode = 301) do
begin
if (AOwner <> nil) and (AOwner is TFMDThread) then
begin
if TFMDThread(AOwner).IsTerminated then
begin
preTerminate;
Exit;
end;
end;

if checkTerminate then Exit;
s := GetHeaderValue(HTTP.Headers, 'location');
s := TrimLeftChar(s, ['/', ':']);
if s <> '' then
Expand All @@ -2454,14 +2484,7 @@ function GetPage(const AOwner: TObject; const AHTTP: THTTPSend;
while (not HTTP.HTTPMethod('GET', URL)) or
(HTTP.ResultCode > 500) do //500 for abort
begin
if (AOwner <> nil) and (AOwner is TFMDThread) then
begin
if TFMDThread(AOwner).IsTerminated then
begin
preTerminate;
Exit;
end;
end;
if checkTerminate then Exit;
if (Reconnect <> 0) and (Reconnect <= counter) then
begin
preTerminate;
Expand Down Expand Up @@ -2595,6 +2618,17 @@ function SaveImage(const AOwner: TObject; const AHTTP: THTTPSend;
HTTPHeader.Free;
end;

function checkTerminate: boolean;
begin
Result := False;
if HTTP.Sock.Tag = 1 then // terminated via OnHeartBeat
begin
Result := True;
HTTP.Sock.Tag := 0;
preTerminate;
end;
end;

begin
s := Path + '/' + Name;
// Check to see if a file with similar name was already exist. If so then we
Expand Down Expand Up @@ -2622,12 +2656,6 @@ function SaveImage(const AOwner: TObject; const AHTTP: THTTPSend;
HTTP.Headers.Add('DNT: 1');

URL := FixURL(URL);
// Site that require HTTPS request should define here
if Pos('https://', URL) <> 0 then
begin
HTTP.Sock.CreateWithSSL(TSSLOpenSSL);
HTTP.Sock.SSLDoConnect;
end;

if ProxyType = 'HTTP' then
begin
Expand Down Expand Up @@ -2678,29 +2706,15 @@ function SaveImage(const AOwner: TObject; const AHTTP: THTTPSend;
end;

{$IFDEF DOWNLOADER}
if (AOwner <> nil) and (AOwner is TFMDThread) then
begin
if TFMDThread(AOwner).IsTerminated then
begin
preTerminate;
Exit;
end;
end;
if checkTerminate then Exit;
{$ENDIF}
counter := 0;
while (not HTTP.HTTPMethod('GET', URL)) or
(HTTP.ResultCode >= 500) or //500 for abort
(HTTP.ResultCode = 403) do
begin
{$IFDEF DOWNLOADER}
if (AOwner <> nil) and (AOwner is TFMDThread) then
begin
if TFMDThread(AOwner).IsTerminated then
begin
preTerminate;
Exit;
end;
end;
if checkTerminate then Exit;
{$ENDIF}
if (Reconnect <> 0) and (Reconnect <= counter) then
begin
Expand All @@ -2717,14 +2731,7 @@ function SaveImage(const AOwner: TObject; const AHTTP: THTTPSend;
while (HTTP.ResultCode = 302) or (HTTP.ResultCode = 301) do
begin
{$IFDEF DOWNLOADER}
if (AOwner <> nil) and (AOwner is TFMDThread) then
begin
if TFMDThread(AOwner).IsTerminated then
begin
preTerminate;
Exit;
end;
end;
if checkTerminate then Exit;
{$ENDIF}

s := GetHeaderValue(HTTP.Headers, 'location');
Expand All @@ -2750,14 +2757,7 @@ function SaveImage(const AOwner: TObject; const AHTTP: THTTPSend;
(HTTP.ResultCode = 403) do
begin
{$IFDEF DOWNLOADER}
if (AOwner <> nil) and (AOwner is TFMDThread) then
begin
if TFMDThread(AOwner).IsTerminated then
begin
preTerminate;
Exit;
end;
end;
if checkTerminate then Exit;
{$ENDIF}
if (Reconnect <> 0) and (Reconnect <= counter) then
begin
Expand Down Expand Up @@ -2796,14 +2796,7 @@ function SaveImage(const AOwner: TObject; const AHTTP: THTTPSend;
repeat
try
{$IFDEF DOWNLOADER}
if (AOwner <> nil) and (AOwner is TFMDThread) then
begin
if TFMDThread(AOwner).IsTerminated then
begin
preTerminate;
Exit;
end;
end;
if checkTerminate then Exit;
{$ENDIF}
lpath := CorrectPathSys(Path);
if not DirectoryExistsUTF8(lpath) then
Expand All @@ -2828,7 +2821,7 @@ function SaveImage(const AOwner: TObject; const AHTTP: THTTPSend;
except
on E: Exception do
begin
putLog('SaveImage: ' + E.Message + LineEnding + (CorrectPathSys(Path) +
WriteLog('SaveImage: ' + E.Message + LineEnding + (CorrectPathSys(Path) +
'/' + Name + prefix + ext), LOG_error);
{$IFDEF DOWNLOADER}
if (AOwner <> nil) and (AOwner is TFMDThread) then
Expand All @@ -2853,7 +2846,7 @@ function SaveImage(const AOwner: TObject; const AHTTP: THTTPSend;
end
else
begin
putLog('SaveImage.ExtEmpty URL:' + URL);
WriteLog('SaveImage.ExtEmpty URL:' + URL);
end;
preTerminate;
end;
Expand Down
2 changes: 1 addition & 1 deletion baseunits/uData.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@
interface

uses
Classes, SysUtils, uBaseUnit, HTTPSend;
Classes, SysUtils, uBaseUnit, httpsend;

type
TDataProcess = class(TObject)
Expand Down
5 changes: 3 additions & 2 deletions baseunits/uDownloadsManager.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ interface

uses
Classes, SysUtils, Dialogs, ExtCtrls, IniFiles, fgl, typinfo, syncobjs,
HTTPSend, blcksock,
httpsend, blcksock,
uBaseUnit, uPacker, uFMDThread, uMisc,
frmShutdownCounter;

Expand Down Expand Up @@ -264,8 +264,9 @@ destructor TDownloadThread.Destroy;

procedure TDownloadThread.SockOnHeartBeat(Sender: TObject);
begin
if Self.Terminated and (TBlockSocket(Sender).StopFlag = False) then
if Terminated then
begin
TBlockSocket(Sender).Tag := 1;
TBlockSocket(Sender).StopFlag := True;
TBlockSocket(Sender).AbortSocket;
end;
Expand Down
4 changes: 3 additions & 1 deletion baseunits/uGetMangaInfosThread.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -163,8 +163,9 @@ procedure TGetMangaInfosThread.DoGetInfos;

procedure TGetMangaInfosThread.SockOnHeartBeat(Sender: TObject);
begin
if Self.Terminated and (TBlockSocket(Sender).StopFlag = False) then
if Terminated then
begin
TBlockSocket(Sender).Tag := 1;
TBlockSocket(Sender).StopFlag := True;
TBlockSocket(Sender).AbortSocket;
end;
Expand Down Expand Up @@ -256,6 +257,7 @@ constructor TGetMangaInfosThread.Create;
inherited Create(True);
FIsFlushed := False;
FInfo := TMangaInformation.Create;
FInfo.FOwner := Self;
FInfo.FHTTP.Sock.OnHeartbeat := SockOnHeartBeat;
FInfo.FHTTP.Sock.HeartbeatRate := SOCKHEARTBEATRATE;
FCover := MainForm.mangaCover;
Expand Down
12 changes: 6 additions & 6 deletions baseunits/uMisc.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,8 +43,8 @@ procedure QuickSortNaturalPart(var Alist: TStringList; Separator: String;
function MangaFoxRemoveWatermarks(const Filename: String): Boolean;

//Logging
procedure putLog(msg: String; logType: TLogType = LOG_debug);
procedure putOtherLog(msg: String);
procedure WriteLog(msg: String; logType: TLogType = LOG_debug);
procedure WriteOtherLog(msg: String);

//Searching
function FindStrLinear(aList: TStrings; aValue: String): Boolean;
Expand Down Expand Up @@ -119,7 +119,7 @@ procedure TIniFileR.Reload;

{ uMisc }

procedure putLog(msg: String; logType: TLogType = LOG_debug);
procedure WriteLog(msg: String; logType: TLogType = LOG_debug);
{$IFDEF LOGACTIVE}
var
s: String;
Expand All @@ -143,7 +143,7 @@ procedure putLog(msg: String; logType: TLogType = LOG_debug);
{$ENDIF}
end;

procedure putOtherLog(msg: String);
procedure WriteOtherLog(msg: String);
{$IFDEF LOGACTIVE}
var
s: String;
Expand Down Expand Up @@ -654,11 +654,11 @@ initialization
{$IFDEF LOGACTIVE}
fLog := TFileStream.Create(fLogFile, fmCreate or fmShareDenyNone);
fOtherLog := TFileStream.Create(fOtherLogFile, fmCreate or fmShareDenyNone);
putLog('Starting FMD', LOG_Info);
WriteLog('Starting FMD', LOG_Info);
{$ENDIF}

finalization
putLog('FMD exit normally', LOG_Info);
WriteLog('FMD exit normally', LOG_Info);
{$IFDEF LOGACTIVE}
FreeAndNil(fLog);
FreeAndNil(fOtherLog);
Expand Down
Loading

0 comments on commit 5407f5a

Please sign in to comment.