paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-24 22:04:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

TurboPower_iPro: Remove Delphi compatibility {$ifdef IP_LAZARUS}. Did not work with Delphi anyways. Issue #37990, patch from Zaher Dirkey.

Browse Source 
git-svn-id: trunk@64097 -
This commit is contained in:
juha 2020-11-01 10:37:53 +00:00
parent 9f72483225
commit d75f2eda2b
12 changed files with 198 additions and 1219 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
components/turbopower_ipro/examples/htmfileexp1.pas
View File

@ -3,23 +3,14 @@ unit HtmFileExp1;
{$mode objfpc}{$H+}
{.$define UsePreview}
{$IFDEF LCL}
{$DEFINE IP_LAZARUS}
{$ENDIF}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
{$IFDEF IP_LAZARUS}
{$ifdef UsePreview}
OsPrinters,
{$endif}
{$ELSE}
GIFImage,
JPeg,
ImageDLLLoader, PNGLoader, LinarBitmap, //from ImageFileLib of Michael Vinther: http://www.logicnet.dk/lib/
{$ENDIF}
{$ifdef UsePreview}
OsPrinters,
{$endif}
IpUtils, IpHtml, ExtCtrls, StdCtrls, FileUtil;
type
@ -123,10 +114,6 @@ procedure TFHtmFileExp1.HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
var
PicCreated: Boolean;
FN, nURL: string;
{$IFNDEF IP_LAZARUS}
Ext: string;
BitMap: Graphics.TBitMap;
{$ENDIF}
begin
PicCreated := False;
try
@ -139,15 +126,10 @@ begin
FN := Concat (FN, nURL);
if FileExistsUTF8(FN) then begin
if Picture = nil then begin
Picture := TPicture.Create;
PicCreated := True;
end;
{$IFNDEF IP_LAZARUS}
Ext := LowerCase (Copy (ExtractFileExt (FN), 2, MaxInt));
if (Ext = 'bmp') or (Ext = 'emf') or (Ext = 'wmf') or (Ext = 'gif') or (Ext = 'jpg') then begin
{$ENDIF}
Picture := TPicture.Create;
PicCreated := True;
end;
Picture.LoadFromFile(FN);
{$IFNDEF IP_LAZARUS}
end
else begin
PicCreated := False;

32
components/turbopower_ipro/examples/htmfileexp2.pas
View File

@ -3,23 +3,14 @@ unit HtmFileExp2;
{$mode objfpc}{$H+}
{.$define UsePreview}
{$IFDEF LCL}
{$DEFINE IP_LAZARUS}
{$ENDIF}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
{$IFDEF IP_LAZARUS}
{$ifdef UsePreview}
OsPrinters,
{$endif}
{$ELSE}
GIFImage,
JPeg,
ImageDLLLoader, PNGLoader, LinarBitmap, //from ImageFileLib of Michael Vinther: http://www.logicnet.dk/lib/
{$ENDIF}
{$ifdef UsePreview}
OsPrinters,
{$endif}
IpHtml, ExtCtrls, StdCtrls, FileUtil;
type
@ -119,10 +110,6 @@ procedure TIpHtmlPanelH.HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
var
PicCreated: Boolean;
FN, nURL: string;
{$IFNDEF IP_LAZARUS}
Ext: string;
BitMap: Graphics.TBitMap;
{$ENDIF}
begin
PicCreated := False;
try
@ -135,17 +122,12 @@ begin
FN := Concat (FN, nURL);
if FileExistsUTF8(FN) then begin
if Picture = nil then begin
Picture := TPicture.Create;
PicCreated := True;
end;
{$IFNDEF IP_LAZARUS}
Ext := LowerCase (Copy (ExtractFileExt (FN), 2, MaxInt));
if (Ext = 'bmp') or (Ext = 'emf') or (Ext = 'wmf') or (Ext = 'gif') or (Ext = 'jpg') then begin
{$ENDIF}
Picture := TPicture.Create;
PicCreated := True;
end;
Picture.LoadFromFile(FN);
{$IFNDEF IP_LAZARUS}
end
else begin
else begin
PicCreated := False;
BitMap := Graphics.TBitMap.Create;
with TLinearBitmap.Create do

9
components/turbopower_ipro/ipanim.pas
View File

@ -37,14 +37,9 @@ unit IpAnim;
interface
uses
{$IFDEF IP_LAZARUS}
LCLType,
GraphType,
LCLIntf,
{$ELSE}
Windows,
Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, IpConst;
@ -607,9 +602,7 @@ var
UseTransparentCopy : Boolean;
begin
{$IFDEF IP_LAZARUS}
if (CurrentFrame=nil) then ;
{$ENDIF}
// Basic clear frame. This should work for just about anything.
DefaultDrawing := False;
UseTransparentCopy := False;
@ -756,9 +749,7 @@ procedure TIpAnimatedGraphic.LoadFromStream (Stream: TStream);
image.
}
begin
{$IFDEF IP_LAZARUS}
if (Stream=nil) then ;
{$ENDIF}
Width := 50;
Height := 50;
Bitmap.Canvas.Brush.Color := clWhite;

20
components/turbopower_ipro/ipfilebroker.pas
View File

@ -31,21 +31,13 @@ unit Ipfilebroker;
interface
{$IFDEF IP_LAZARUS}
uses Classes, SysUtils, LResources, Graphics, LCLProc, LazFileUtils, LazUTF8,
ipconst, iputils, iphtml, ipmsg;
{$ELSE}
uses
Windows, SysUtils, Graphics, Classes, Dialogs, ShellApi,
IpConst, IpUtils, {IpSock, IpCache,} IpHtml, {IpHttp,} IpMsg, IpStrms{, IpFtp};
{$ENDIF}
const
IP_DEFAULT_SCHEME : string = 'HTTP';
{$IFDEF IP_LAZARUS}
function expandLocalHtmlFileName (URL : string) : string;
{$ENDIF}
type
@ -124,9 +116,7 @@ type
public
constructor Create(AOwner : TComponent); override;
function GetHtmlStream(const URL : string; PostData : TIpFormDataEntity) : TStream; override;
{$IFDEF IP_LAZARUS}
function DoGetStream(const URL: string): TStream; override;
{$ENDIF}
function CheckURL(const URL : string; var ContentType : string) : Boolean; override;
procedure Leave(Html : TIpHtml); override;
procedure Reference(const URL : string); override;
@ -138,7 +128,6 @@ procedure Register;
implementation
{$IFDEF IP_LAZARUS}
function expandLocalHtmlFileName (URL : string) : string;
begin
if pos ('FILE://', ansiuppercase(URL)) = 0 then
@ -146,7 +135,6 @@ begin
else
result := URL;
end;
{$ENDIF}
{ TIpCustomHtmlDataProvider }
constructor TIpCustomHtmlDataProvider.Create(AOwner : TComponent);
@ -165,9 +153,7 @@ function TIpCustomHtmlDataProvider.BuildURL(const Old,
New : string) : string;
begin
Result := IpUtils.BuildURL(Old, New);
{$IFDEF IP_LAZARUS}
//DebugLn('TIpCustomHtmlDataProvider.BuildURL Old="',old,'" new="',New,'"');
{$ENDIF}
end;
function TIpCustomHtmlDataProvider.CanHandle(const URL : string) : Boolean;
@ -299,15 +285,11 @@ var
ContentType, FN : string;
begin
Initialize(FileAddrRec);
{$IFDEF IP_LAZARUS}
//DebugLn('TIpFileDataProvider.CanHandle('+URL+')');
{$ENDIF}
FN := BuildURL(FOldURL, URL);
IpParseURL(FN, FileAddrRec);
FN := NetToDosPath(FileAddrRec.Path);
{$IFDEF IP_LAZARUS}
//DebugLn('TIpFileDataProvider.CanHandle FN="'+FN+'"');
{$ENDIF}
ContentType := UpperCase(GetLocalContent(FN));
Result := (FileExistsUTF8(FN)) and ((Pos('TEXT/HTML', ContentType) > 0) or
(Pos('IMAGE/', ContentType) > 0));
@ -343,7 +325,6 @@ begin
Finalize(FileAddrRec);
end;
{$IFDEF IP_LAZARUS}
function TIpFileDataProvider.DoGetStream(const URL: string): TStream;
var
FileAddrRec : TIpAddrRec;
@ -361,7 +342,6 @@ begin
end;
Finalize(FileAddrRec);
end;
{$ENDIF}
procedure TIpFileDataProvider.GetImage(Sender : TIpHtmlNode;
const URL : string; var Picture : TPicture);

881
components/turbopower_ipro/iphtml.pas
View File

File diff suppressed because it is too large Load Diff

50
components/turbopower_ipro/iphtmlblocklayout.pas
View File

@ -129,7 +129,7 @@ begin
inherited Create(AOwner);
FIpHtml := FOwner.Owner;
FBlockOwner := TIpHtmlNodeBlock(FOwner);
FElementQueue := {$ifdef IP_LAZARUS}TFPList{$else}TList{$endif}.Create;
FElementQueue := TFPList.Create;
end;
destructor TIpNodeBlockLayouter.Destroy;
@ -169,17 +169,10 @@ begin // Debug: remove assertions later
Assert(FCanvas.Font.Name = aProps.FontName, 'UpdPropMetrics: FCanvas.Font.Name <> aProps.FontName');
Assert(FCanvas.Font.Size = aProps.FontSize, 'UpdPropMetrics: FCanvas.Font.Size <> aProps.FontSize');
Assert(FCanvas.Font.Style = aProps.FontStyle, 'UpdPropMetrics: FCanvas.Font.Style <> aProps.FontStyle');
{$IFDEF IP_LAZARUS}
FCanvas.GetTextMetrics(TextMetrics);
aProps.PropA.tmAscent := TextMetrics.Ascender;
aProps.PropA.tmDescent := TextMetrics.Descender;
aProps.PropA.tmHeight := TextMetrics.Height;
{$ELSE}
GetTextMetrics(FCanvas.Handle, TextMetrics);
aProps.PropA.tmAscent := TextMetrics.tmAscent;
aProps.PropA.tmDescent := TextMetrics.tmDescent;
aProps.PropA.tmHeight := TextMetrics.tmHeight;
{$ENDIF}
end;
procedure TIpNodeBlockLayouter.Layout(RenderProps: TIpHtmlProps; TargetRect: TRect);
@ -256,7 +249,6 @@ begin
end;
procedure TIpNodeBlockLayouter.InitMetrics;
{$IFDEF IP_LAZARUS}
var
TextMetrics : TLCLTextMetric;
begin
@ -265,16 +257,6 @@ begin
FBlockDescent := TextMetrics.Descender;
FBlockHeight := TextMetrics.Height;
end;
{$ELSE}
var
TextMetrics : TTextMetric;
begin
GetTextMetrics(aCanvas.Handle, TextMetrics);
BlockAscent := TextMetrics.tmAscent;
BlockDescent := TextMetrics.tmDescent;
BlockHeight := TextMetrics.tmHeight;
end;
{$ENDIF}
function TIpNodeBlockLayouter.QueueLeadingObjects: Integer;
// Returns the first element index.
@ -756,20 +738,17 @@ end;
procedure TIpNodeBlockLayouter.SetWordInfoLength(NewLength : Integer);
var
NewWordInfoSize: Integer;
{$IFNDEF IP_LAZARUS}
NewWordInfo: PWordList;
{$ENDIF}
begin
if (FWordInfo = nil) or (NewLength > FWordInfoSize) then begin
NewWordInfoSize := ((NewLength div 256) + 1) * 256;
{$IFDEF IP_LAZARUS code below does not check if FWordInfo<>nil}
//code below does not check if FWordInfo<>nil
ReallocMem(FWordInfo,NewWordInfoSize * sizeof(TWordInfo));
{$ELSE}
(*
NewWordInfo := AllocMem(NewWordInfoSize * sizeof(TWordInfo));
move(WordInfo^, NewWordInfo^, WordInfoSize);
Freemem(WordInfo);
WordInfo := NewWordInfo;
{$ENDIF}
*)
FWordInfoSize := NewWordInfoSize;
end;
end;
@ -1237,9 +1216,7 @@ end;
procedure TIpNodeBlockLayouter.DoRenderFont(var aCurWord: PIpHtmlElement);
begin
{$IFDEF IP_LAZARUS}
FCanvas.Font.BeginUpdate; // for speedup
{$ENDIF}
if (FCurProps = nil) or not FCurProps.AIsEqualTo(aCurWord.Props) then
with aCurWord.Props do begin
FCanvas.Font.Name := FontName;
@ -1255,9 +1232,7 @@ begin
if (FCurProps = nil) or not FCurProps.BIsEqualTo(aCurWord.Props) then
FCanvas.Font.Color := aCurWord.Props.FontColor;
FIpHtml.Target.Font.Quality := FIpHtml.FontQuality;
{$IFDEF IP_LAZARUS}
FIpHtml.Target.Font.EndUpdate;
{$ENDIF}
FCurProps := aCurWord.Props;
end;
@ -1266,7 +1241,6 @@ procedure TIpNodeBlockLayouter.DoRenderElemWord(aCurWord: PIpHtmlElement;
var
P : TPoint;
R : TRect;
{$IFDEF IP_LAZARUS}
TextStyle: TTextStyle;
OldBrushcolor: TColor;
OldFontColor: TColor;
@ -1291,7 +1265,6 @@ var
FCanvas.Font.Style := OldFontStyle;
FCanvas.Font.Quality := OldFontQuality;
end;
{$ENDIF}
begin
P := FIpHtml.PagePtToScreen(aCurWord.WordRect2.TopLeft);
@ -1302,7 +1275,6 @@ begin
then
exit;
{$IFDEF IP_LAZARUS}
//if (LastOwner <> aCurWord.Owner) then LastPoint := P;
saveCanvasProperties;
TextStyle := FCanvas.TextStyle;
@ -1323,10 +1295,7 @@ begin
else
begin
TextStyle.Opaque := True;
{$ENDIF}
FCanvas.Brush.Style := bsClear;
{$IFDEF IP_LAZARUS}
end;
if aCurWord.Owner.ParentNode = aCurTabFocus then
@ -1334,16 +1303,9 @@ begin
if FCanvas.Font.Color = clNone then
FCanvas.Font.Color := clBlack;
FCanvas.Font.Quality := FOwner.Owner.FontQuality;
{$ENDIF}
if aCurWord.AnsiWord <> NAnchorChar then
{$IFDEF IP_LAZARUS}
FCanvas.TextRect(R, P.x, P.y, NoBreakToSpace(aCurWord.AnsiWord), TextStyle);
{$ELSE}
FCanvas.TextRect(R, P.x, P.y, NoBreakToSpace(aCurWord.AnsiWord));
{$ENDIF}
{$IFDEF IP_LAZARUS}
RestoreCanvasProperties;
{$ENDIF}
FIpHtml.AddRect(aCurWord.WordRect2, aCurWord, FBlockOwner);
end;
@ -1361,14 +1323,12 @@ begin
L0 := FBlockOwner.Level0;
FCurProps := nil;
FCanvas := FIpHtml.Target;
{$IFDEF IP_LAZARUS}
// to draw focus rect
i := FIpHtml.TabList.Index;
if (FIpHtml.TabList.Count > 0) and (i <> -1) then
CurTabFocus := TIpHtmlNode(FIpHtml.TabList[i])
else
CurTabFocus := nil;
{$ENDIF}
for i := 0 to pred(FElementQueue.Count) do begin
CurWord := PIpHtmlElement(FElementQueue[i]);
@ -1533,9 +1493,7 @@ var
begin
Props.Assign(RenderProps);
Props.DelayCache:=True;
{$IFDEF IP_LAZARUS}
FOwner.LoadAndApplyCSSProps;
{$ENDIF}
//DebugLn('td :', IntToStr(Integer(Props.Alignment)));
if FTableElemOwner.BgColor <> clNone then
Props.BgColor := FTableElemOwner.BgColor;

13
components/turbopower_ipro/iphtmlpv.pas
View File

@ -39,14 +39,10 @@ unit IpHtmlPv;
interface
uses
{$IFDEF IP_LAZARUS}
LCLType,
GraphType,
LCLIntf,
Buttons,
{$ELSE}
Windows,
{$ENDIF}
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Spin, IpHtml, IpConst;
@ -123,11 +119,7 @@ implementation
uses
Printers;
{$IFNDEF IP_LAZARUS}
{$R *.DFM}
{$ELSE}
{$R *.lfm}
{$ENDIF}
const
SCRATCH_WIDTH = 800; //640;
@ -368,7 +360,6 @@ procedure TIpHTMLPreview.ResizeCanvas;
begin
ScrollBox1.HorzScrollBar.Position := 0;
ScrollBox1.VertScrollBar.Position := 0;
{$IFDEF IP_LAZARUS}
if Printer.PageHeight > 0 then
PaperPanel.Height := round(Printer.PageHeight * Scale)
else
@ -377,10 +368,6 @@ begin
PaperPanel.Width := round(Printer.PageWidth * Scale)
else
PaperPanel.Width := round(500 * Scale);
{$ELSE}
PaperPanel.Width := round(Printer.PageWidth * Scale);
PaperPanel.Height := round(Printer.PageHeight * Scale);
{$ENDIF}
PaintBox1.Left := round(OwnerPanel.PrintTopLeft.x * Scale);
PaintBox1.Top := round(OwnerPanel.PrintTopLeft.y * Scale);

80
components/turbopower_ipro/iphtmltablelayout.pas
View File

@ -278,11 +278,7 @@ begin
begin
if CellNode.Width.LengthValue <= CellNode.ExpParentWidth then
Min0 := MaxI2(Min0, CellNode.Width.LengthValue - 2*FCellPadding
{$IFDEF IP_LAZARUS}
- FCellSpacing - RUH);
{$ELSE}
- 2*CS2 - RUH);
{$ENDIF}
Max0 := Min0;
end;
end;
@ -318,19 +314,11 @@ begin
TWMin := 0;
TWMax := 0;
{$IFDEF IP_LAZARUS}
CellOverhead := BL + FCellSpacing + BR;
{$ELSE}
CellOverhead := BL + 2*CS2 + RUH + BR;
{$ENDIF}
for i := 0 to Pred(ColCount) do begin
Inc(TWMin, ColTextWidthMin[i]);
Inc(TWMax, ColTextWidthMax[i]);
{$IFDEF IP_LAZARUS}
Inc(CellOverhead, RUH + 2*FCellPadding + FCellSpacing + RUH);
{$ELSE}
Inc(CellOverhead, 2*FCellPadding + 2*CS2 + RUH);
{$ENDIF}
FRowSp[i] := 0;
end;
@ -466,36 +454,17 @@ var
CellRect1 := TargetRect;
Inc(CellRect1.Left, ColStart[CurCol]);
{$IFDEF IP_LAZARUS}
Inc(CellRect1.Top, FCellSpacing + RUV);
{$ELSE}
Inc(CellRect1.Top, CS2 + RUV);
{$ENDIF}
CellRect1.Right := CellRect1.Left + 2*FCellPadding + ColTextWidth[CurCol]
{$IFnDEF IP_LAZARUS}
+ 2*CS2
{$ENDIF}
;
CellRect1.Right := CellRect1.Left + 2*FCellPadding + ColTextWidth[CurCol];
for k := 1 to CellNode.ColSpan - 1 do
Inc(CellRect1.Right, ColTextWidth[CurCol + k] + 2*FCellPadding +
{$IFDEF IP_LAZARUS}
2*RUH + FCellSpacing);
{$ELSE}
2*CS2 + RUH);
{$ENDIF}
{$IFDEF IP_LAZARUS}
// PadRect area of cell excluding rules
// CellRect area of text contained in cell
CellNode.PadRect := CellRect1;
Inc(CellRect1.Top, FCellPadding);
inflateRect(CellRect1, -FCellPadding, 0);
{$ELSE}
FPadRect := CellRect1;
InflateRect(FPadRect, -CS2, 0);
Inc(CellRect1.Top, FCellPadding);
InflateRect(CellRect1, -(FCellPadding + CS2), 0);
{$ENDIF}
VA := CellNode.VAlign;
if VA = hva3Default then
@ -563,11 +532,7 @@ var
AL := AL0;
{$IFDEF IP_LAZARUS}
HA := maxYY - (TargetRect.Top + FCellSpacing + RUV);
{$ELSE}
HA := maxYY - TargetRect.Top;
{$ENDIF}
HB := CellNode.PageRect.Bottom - CellNode.PageRect.Top;
VA := CellNode.VAlign;
@ -586,30 +551,14 @@ var
if Y0 > 0 then begin
CellRect1 := TargetRect;
Inc(CellRect1.Left, ColStart[CurCol]);
{$IFDEF IP_LAZARUS}
Inc(CellRect1.Top, FCellSpacing + RUV + Y0);
{$ELSE}
Inc(CellRect1.Top, CS2 + RUV + Y0);
{$ENDIF}
CellRect1.Right := CellRect1.Left + 2*FCellPadding + ColTextWidth[CurCol]
{$IFnDEF IP_LAZARUS}
+ 2*CS2
{$ENDIF}
;
CellRect1.Right := CellRect1.Left + 2*FCellPadding + ColTextWidth[CurCol];
for k := 1 to CellNode.ColSpan - 1 do
Inc(CellRect1.Right, ColTextWidth[CurCol + k] + 2*FCellPadding +
{$IFDEF IP_LAZARUS}
2*RUH + FCellSpacing);
{$ELSE}
2*CS2 + RUH);
{$ENDIF}
Inc(CellRect1.Top, FCellPadding);
{$IFDEF IP_LAZARUS}
inflateRect(CellRect1, -FCellPadding, 0);
{$ELSE}
InflateRect(CellRect1, -(FCellPadding + CS2), 0);
{$ENDIF}
case CellNode.Align of
haDefault : ;
@ -656,11 +605,7 @@ var
if FRowSp[j] > 0 then
FRowSp[j] := FRowSp[j] - 1;
{$IFDEF IP_LAZARUS}
TargetRect.Top := MaxI2(maxYY, TargetRect.Top) + RUV;
{$ELSE}
TargetRect.Top := MaxI2(maxYY, TargetRect.Top);
{$ENDIF}
DeleteFirstSpanRow;
end;
end;
@ -763,11 +708,7 @@ begin
case CellNode.Width.LengthType of
hlAbsolute :
AdjustCol(CellNode.ColSpan, CellNode.Width.LengthValue - 2*FCellPadding
{$IFDEF IP_LAZARUS}
- FCellSpacing - RUH);
{$ELSE}
- 2*CS2 - RUH);
{$ENDIF}
hlPercent :
AdjustCol(CellNode.Colspan,
round((FTableWidth - CellOverhead) *
@ -878,19 +819,11 @@ begin
R := BorderRect;
end;
{$IFDEF IP_LAZARUS}
ColStart[0] := BL + FCellSpacing + RUH;
{$ELSE}
ColStart[0] := BL + CS2 + RUH;
{$ENDIF}
FRowSp[0] := 0;
for i := 1 to Pred(ColCount) do begin
ColStart[i] := ColStart[i-1] + 2*FCellPadding + ColTextWidth[i-1]
{$IFDEF IP_LAZARUS}
+ FCellSpacing + 2*RUH;
{$ELSE}
+ 2*CS2 + RUH;
{$ENDIF}
FRowSp[i] := 0;
end;
@ -908,11 +841,7 @@ begin
RowFixup.Free;
end;
{$IFDEF IP_LAZARUS}
Inc(TargetRect.Top, FCellSpacing + RUV + BB);
{$ELSE}
Inc(TargetRect.Top, CS2 + RUV + BB);
{$ENDIF}
R.Right := R.Left + FTableWidth;
R.Bottom := TargetRect.Top;
@ -964,11 +893,6 @@ begin
FColCount := c;
end;
end;
{$IFnDEF IP_LAZARUS}
CS2 := FCellSpacing div 2;
if (FCellSpacing > 0) and (CS2 = 0) then
CS2 := 1;
{$ENDIF}
RUH := 0;
RUV := 0;
case FTableOwner.Rules of

4
components/turbopower_ipro/iphttpbroker.pas
View File

@ -58,9 +58,7 @@ type
destructor Destroy; override;
function GetHtmlStream(const AUrl: string;
APostData: TIpFormDataEntity): TStream; override;
{$IFDEF IP_LAZARUS}
function DoGetStream(const AUrl: string): TStream; override;
{$ENDIF}
function CheckURL(const AUrl: string;
var AContentType: string): Boolean; override;
procedure Leave(AHtml: TIpHtml); override;
@ -104,14 +102,12 @@ begin
Result.Seek(0, soFromBeginning);
end;
{$IFDEF IP_LAZARUS}
function TIpHttpDataProvider.DoGetStream(const AUrl: string): TStream;
begin
Result := TMemoryStream.Create;
Result.CopyFrom(FDocumment, 0);
Result.Seek(0, soFromBeginning);
end;
{$ENDIF}
function TIpHttpDataProvider.CheckURL(const AUrl: string;
var AContentType: string): Boolean;

16
components/turbopower_ipro/ipmsg.pas
View File

@ -40,19 +40,12 @@ unit IpMsg;
interface
uses
{$IFDEF IP_LAZARUS}
LCLType,
LCLIntf,
LazFileUtils, LazUTF8Classes,
{$ELSE}
Windows,
{$ENDIF}
Classes,
SysUtils,
IpStrms,
{$IFNDEF IP_LAZARUS}
//IpSock, //JMN
{$ENDIF}
IpUtils,
IpConst;
@ -568,15 +561,6 @@ type
procedure SaveToStream(aStream : TStream);
end;
{$IFNDEF IP_LAZARUS}
{ dummy class so this unit will be added to the uses clause when an }
{ IpPop3Client, IpSmtpClient or IpNntpClient component is dropped on the form }
(*** //JMN
TIpCustomEmailClass = class(TIpCustomClient)
end;
**)
{$ENDIF}
function IpBase64EncodeString(const InStr: string): string; {!!.02}{!!.03}
{Begin !!.12}

94
components/turbopower_ipro/ipstrms.pas
View File

@ -42,14 +42,10 @@ interface
uses
SysUtils, Classes,
{$IFDEF IP_LAZARUS}
// LCL
LCLType,
// LazUtils
FPCAdds, LazFileUtils, IntegerList,
{$ELSE}
Windows, // put Windows behind Classes because of THandle
{$ENDIF}
IpUtils,
IpConst;
@ -147,7 +143,7 @@ type
FBufPos : Longint;
FBufSize : Longint;
FDirty : Boolean;
FSize : {$IFDEF IP_LAZARUS}TStreamSeekType{$ELSE}longint{$ENDIF};
FSize : TStreamSeekType;
FStream : TStream;
protected {- methods }
@ -170,7 +166,7 @@ type
function Write(const Buffer; Count : Longint) : Longint; override;
public {-properties }
property FastSize: {$IFDEF IP_LAZARUS}TStreamSeekType{$ELSE}longint{$ENDIF}
property FastSize: TStreamSeekType
read FSize;
property Stream : TStream
read FStream write bsSetStream;
@ -350,26 +346,21 @@ end;
procedure TIpMemMapStream.CloseFile;
begin
{$IFDEF IP_LAZARUS}
writeln('TIpMemMapStream.CloseFile ToDo');
{$ELSE}
if mmFileHandle <> 0 then
CloseHandle(mmFileHandle);
{$ENDIF}
{ if mmFileHandle <> 0 then
CloseHandle(mmFileHandle);}
end;
{-----------------------------------------------------------------------------}
procedure TIpMemMapStream.CloseMap;
begin
{$IFDEF IP_LAZARUS}
writeln('TIpMemMapStream.CloseMap ToDo');
{$ELSE}
FlushViewOfFile(mmPointer, 0);
{ FlushViewOfFile(mmPointer, 0);
UnMapViewOfFile(mmPointer);
if mmMapHandle <> 0 then
CloseHandle(mmMapHandle);
{$ENDIF}
}
end;
{-----------------------------------------------------------------------------}
@ -383,11 +374,10 @@ end;
{-----------------------------------------------------------------------------}
procedure TIpMemMapStream.OpenFile;
{$IFDEF IP_LAZARUS}
begin
writeln('TIpMemMapStream.OpenFile ToDo');
end;
{$ELSE}
(*
var
CreateMode,
Flags,
@ -427,16 +417,15 @@ begin
raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
mmFileName);
end;
{$ENDIF}
*)
{-----------------------------------------------------------------------------}
procedure TIpMemMapStream.OpenMap;
{$IFDEF IP_LAZARUS}
begin
writeln('TIpMemMapStream.OpenMap ToDo');
end;
{$ELSE}
(*
var
AccessMode,
ProtectMode,
@ -480,7 +469,7 @@ begin
mmFileName);
mmPos := 0;
end;
{$ENDIF}
*)
{-----------------------------------------------------------------------------}
@ -495,9 +484,8 @@ begin
SavPos := mmPos;
CloseMap;
{$IFDEF IP_LAZARUS}
writeln('TIpMemMapStream.Resize ToDo');
{$ELSE}
(*
{ Update the size of the file. }
if SetFilePointer(mmFileHandle, NewSize, nil, FILE_BEGIN) <> $FFFFFFFF then begin
if SetEndOfFile(mmFileHandle) = false then
@ -507,7 +495,7 @@ begin
else
raise EIpBaseException.Create(SysErrorMessage(GetLastError) + SFilename +
mmFileName);
{$ENDIF}
*)
{ Update internal size information. }
FSize := NewSize;
@ -1151,32 +1139,12 @@ begin
be less than it because we read the last line of all and it was
short}
StLen := FixedLineLength;
{$IFDEF MSWindows}
SetLength(Result, StLen);
{$ELSE}
{$IFDEF IP_LAZARUS}
SetLength(Result, StLen);
{$ELSE}
if (StLen > 255) then
StLen := 255;
Result[0] := char(StLen);
{$ENDIF}
{$ENDIF}
if (Len < StLen) then
FillChar(Result[Len+1], StLen-Len, ' ');
end
else {LineTerminator is not ltNone} begin
{$IFDEF MSWindows}
SetLength(Result, Len);
{$ELSE}
{$IFDEF IP_LAZARUS}
SetLength(Result, Len);
{$ELSE}
if (Len > 255) then
Len := 255;
Result[0] := char(Len);
{$ENDIF}
{$ENDIF}
end;
{read the line}
Seek(CurPos, soFromBeginning);
@ -1596,13 +1564,11 @@ end;
destructor TIpDownloadFileStream.Destroy;
begin
{$IFDEF IP_LAZARUS}
writeln('ToDo: TIpDownloadFileStream.Destroy ');
{$ELSE}
FlushFileBuffers(FHandle);
{ FlushFileBuffers(FHandle);
if (Handle <> INVALID_HANDLE_VALUE) then
CloseHandle(Handle);
{$ENDIF}
}
inherited Destroy;
end;
@ -1623,12 +1589,11 @@ begin
end;
function TIpDownloadFileStream.Read(var Buffer; Count : Longint) : Longint;
{$IFDEF IP_LAZARUS}
begin
writeln('ToDo: TIpDownloadFileStream.Read ');
Result:=0;
end;
{$ELSE}
{
var
ReadOK : Bool;
begin
@ -1639,25 +1604,22 @@ begin
Result := 0;
end;
end;
{$ENDIF}
}
procedure TIpDownloadFileStream.Rename(aNewName : string);
var
NewFullName : string;
begin
{$IFDEF IP_LAZARUS}
writeln('ToDo: TIpDownloadFileStream.Rename ');
{$ENDIF}
{close the current handle}
{$IFNDEF IP_LAZARUS}
CloseHandle(Handle);
{$ENDIF}
// CloseHandle(Handle);
FHandle := IpFileOpenFailed;
{calculate the full new name}
NewFullName := FPath + '\' + aNewName;
{rename the file}
{$IFDEF Version6OrHigher}
{$IFNDEF IP_LAZARUS}
{$IFNDEF IP_LAZARUS} //TODO need review
if not MoveFile(PAnsiChar(FFileName), PAnsiChar(NewFullName)) then
RaiseLastOSError;
{$ENDIF}
@ -1684,17 +1646,13 @@ end;
procedure TIpDownloadFileStream.Move(aNewName : string);
begin
{$IFDEF IP_LAZARUS}
writeln('ToDo: TIpDownloadFileStream.Move ');
{$ENDIF}
{close the current handle}
{$IFNDEF IP_LAZARUS}
CloseHandle(Handle);
{$ENDIF}
//CloseHandle(Handle);
FHandle := IpFileOpenFailed;
{copy the file} {!!.01}
{$IFDEF Version6OrHigher}
{$IFNDEF IP_LAZARUS}
{$IFNDEF IP_LAZARUS} //TODO Need review
if not CopyFile(PAnsiChar(FFileName), PAnsiChar(aNewName), False) then
RaiseLastOSError;
{$ENDIF}
@ -1723,21 +1681,17 @@ end;
function TIpDownloadFileStream.Seek(Offset : Longint; Origin : Word) : Longint;
begin
{$IFDEF IP_LAZARUS}
writeln('ToDo: TIpDownloadFileStream.Seek');
Result := 0;
{$ELSE}
Result := SetFilePointer(Handle, Offset, nil, Origin);
{$ENDIF}
//Result := SetFilePointer(Handle, Offset, nil, Origin);
end;
function TIpDownloadFileStream.Write(const Buffer; Count : Longint) : Longint;
{$IFDEF IP_LAZARUS}
begin
writeln('ToDo: TIpDownloadFileStream.Write');
Result:=Count;
end;
{$ELSE}
{
var
WriteOK : Bool;
begin
@ -1748,7 +1702,7 @@ begin
Result := 0
end;
end;
{$ENDIF}
}
{ TIpByteStream }

188
components/turbopower_ipro/iputils.pas
View File

@ -36,12 +36,7 @@ interface
uses
SysUtils, Classes, Controls, Registry, ComCtrls,
{$IFDEF IP_LAZARUS}
LCLType, GraphType, LCLIntf, LMessages, LazFileUtils, lazutf8classes, LCLProc;
{$ELSE}
Messages, Windows, ExtCtrls, SyncObjs;
{$ENDIF}
const
InternetProfessionalVersion = 1.15;
@ -73,9 +68,7 @@ const
CM_IPSMTPEVENT = IpMsgBase + 21;
CM_IPPOP3EVENT = IpMsgBase + 22;
CM_IPNNTPEVENT = IpMsgBase + 23;
{$IFDEF IP_LAZARUS}
CM_IPHOTINVOKE = IpMsgBase + 24;
{$ENDIF}
type
TIpLineTerminator = (ltNone, ltCR, ltLF, ltCRLF, ltOther);
@ -107,11 +100,7 @@ type
TIpBaseAccess = class
private
{$IFDEF IP_LAZARUS}
baPropCS : TCriticalSection;
{$ELSE}
baPropCS : TRTLCriticalSection;
{$ENDIF}
public
constructor Create; virtual;
destructor Destroy; override;
@ -121,11 +110,7 @@ type
TIpBasePersistent = class(TPersistent)
private
{$IFDEF IP_LAZARUS}
bpPropCS : TCriticalSection;
{$ELSE}
bpPropCS : TRTLCriticalSection;
{$ENDIF}
public
constructor Create; virtual;
destructor Destroy; override;
@ -210,10 +195,8 @@ type
QueryDelim : AnsiChar;
end;
{$IFDEF IP_LAZARUS}
procedure Initialize(var AddrRec: TIpAddrRec);
procedure Finalize(var AddrRec: TIpAddrRec);
{$ENDIF}
function ExtractEntityName(const NamePath: string): string;
function ExtractEntityPath(const NamePath: string): string;
@ -254,16 +237,12 @@ implementation
{ Allow other processes a chance to run }
function SafeYield : LongInt;
{$IFNDEF IP_LAZARUS}
var
Msg : TMsg;
{$ENDIF}
begin
SafeYield := 0;
{$IFDEF IP_LAZARUS}
writeln('ToDo: IpUtils.SafeYield');
exit;
{$ELSE}
(*
var
Msg : TMsg;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin
if Msg.Message = wm_Quit then
{Re-post quit message so main message loop will terminate}
@ -274,8 +253,7 @@ begin
end;
{Return message so caller can act on message if necessary}
SafeYield := MAKELONG(Msg.Message, Msg.hwnd);
end;
{$ENDIF}
*)
end;
{ Trim leading and trailing spaces from a string }
@ -457,7 +435,6 @@ begin
Result := Result + (Idx - 1);
end;
{$IFDEF IP_LAZARUS}
procedure Initialize(var AddrRec: TIpAddrRec);
begin
AddrRec.QueryDelim:=#0;
@ -476,7 +453,6 @@ begin
Query :='';
end;
end;
{$ENDIF}
const
CrcBufSize = 2048;
@ -861,7 +837,6 @@ end;
{ Compares two fixed size structures }
function IpCompStruct(const S1, S2; Size : Cardinal) : Integer;
{$IFDEF IP_LAZARUS}
{$IFDEF CPUI386}
asm
push edi
@ -888,34 +863,6 @@ begin
Result := CompareMemRange(@S1, @S2, Size);
end;
{$ENDIF}
{$ELSE}
{$IFDEF CPU386}
asm
push edi
push esi
mov esi, eax
mov edi, edx
xor eax, eax
or ecx, ecx
jz @@CSDone
repe cmpsb
je @@CSDone
inc eax
ja @@CSDone
or eax, -1
@@CSDone:
pop esi
pop edi
end;
{$ELSE}
begin
Result := CompareMemRange(@S1, @S2, Size);
end;
{$ENDIF}
{$ENDIF}
function IpCharCount(const Buffer; BufSize : DWORD; C : AnsiChar) : DWORD;
register;
@ -1086,17 +1033,13 @@ end;
{ Returns an appropriate string for the given parameters }
class function TIpBaseComponent.GetLogString(const S, D1, D2, D3: DWORD): string;
begin
{$IFDEF IP_LAZARUS}
if (S=0) or (D1=0) or (D2=0) or (D3=0) then ; // avoid hints
{$ENDIF}
Result := '!!!! Unhandled log entry'#10#13;
Result := '!!!! Unhandled log entry'#10#13;
end;
procedure TIpBaseComponent.SetVersion(const Value: string);
begin
{$IFDEF IP_LAZARUS}
if (Value='') then ; // avoid hints
{$ENDIF}
{ Intentionally empty }
end;
@ -1109,9 +1052,7 @@ end;
procedure TIpBaseWinControl.SetVersion(const Value : string);
begin
{$IFDEF IP_LAZARUS}
if (Value='') then ; // avoid hints
{$ENDIF}
{ Intentionally empty }
end;
@ -1183,11 +1124,7 @@ begin
for i := 1 to Length(Result) do begin
case Result[i] of
'|': Result[i] := ':';
{$IFDEF IP_LAZARUS}
'/': Result[i] := DirectorySeparator;
{$ELSE}
'/': Result[i] := '\';
{$ENDIF}
else
{ leave it alone };
end;
@ -1208,11 +1145,7 @@ begin
for i := 1 to Length(Result) do begin
case Result[i] of
':': Result[i] := '|';
{$IFDEF IP_LAZARUS}
DirectorySeparator: Result[i] := '/';
{$ELSE}
'\': Result[i] := '/';
{$ENDIF}
else
{ leave it alone };
end;
@ -1317,9 +1250,7 @@ var
State : TUrlParseState;
PotAuth, PotPath : string;
SchemeSeen: Boolean;
{$IFDEF IP_LAZARUS}
SlashCount: integer;
{$ENDIF}
procedure ProcessChar;
begin
@ -1398,9 +1329,7 @@ begin
SchemeSeen := True;
PotAuth := '';
State := psSchemeSlashes;
{$IFDEF IP_LAZARUS}
SlashCount := 0;
{$ENDIF}
end
else begin
@ -1454,9 +1383,7 @@ begin
SchemeSeen := True;
PotAuth := '';
State := psSchemeSlashes;
{$IFDEF IP_LAZARUS}
SlashCount := 0;
{$ENDIF}
end;
'A'..'Z', 'a'..'z': begin
@ -1483,30 +1410,25 @@ begin
end;
psSchemeSlashes: begin
{$IFDEF IP_LAZARUS}
inc(SlashCount);
if (p^ <> '/') or (SlashCount > 2) then
{$ENDIF}
case P^ of
{$IFNDEF IP_LAZARUS}
'/': { ignore };
{$ENDIF}
'.', '\'{$IFDEF IP_LAZARUS},'/'{$ENDIF}: begin { start of a local path }
PotPath := PotPath + P^;
State := psLocalPath;
end;
case P^ of
'.', '\','/': begin { start of a local path }
PotPath := PotPath + P^;
State := psLocalPath;
end;
else begin
if CharPos('@', URL) > 0 then begin
PotAuth := P^;
State := psUserName;
end
else begin
PotAuth := P^;
State := psPotAuth;
if CharPos('@', URL) > 0 then begin
PotAuth := P^;
State := psUserName;
end
else begin
PotAuth := P^;
State := psPotAuth;
end;
end;
end;
end;
end;
@ -2655,13 +2577,12 @@ end;
{ returns the current local TimeZone "bias" in minutes from UTC (GMT) }
function TimeZoneBias : Integer;
{$IFDEF IP_LAZARUS}
begin
Result:=0;
writeln('TimeZoneBias ToDo');
end;
{$ELSE}
{$IFDEF VERSION3}
(*
const
TIME_ZONE_ID_UNKNOWN = 0;
TIME_ZONE_ID_STANDARD = 1;
@ -2677,7 +2598,7 @@ begin
TIME_ZONE_ID_DAYLIGHT : Result := TZI.Bias + TZI.DaylightBias;
end;
end;
{$ENDIF}
*)
{ Format TDateTime to standard HTTP date string }
function DateTimeToINetDateTimeStr(DateTime: TDateTime): string;
@ -2699,7 +2620,6 @@ end;
{ File/Directory Stuff }
{ Retreive Windows "MIME" type for a particular file extension }
{$IFDEF IP_LAZARUS}
{$ifndef MSWindows}
{define some basic mime types}
const MimeTypeExt : Array[0..4] of String = ('.htm','.html','.txt','.jpg','.png');
@ -2742,105 +2662,39 @@ begin
//DebugLn('IpUtils.GetLocalContent File:'+TheFileName+' Result:'+result);
end;
{$ELSE}
{ Retreive Windows "MIME" type for a particular file extension }
function GetLocalContent(const TheFileName: string): string;
var
Reg : TRegistry;
Ext : string;
begin
Result := '';
Ext := ExtractFileExt(TheFileName);
Reg := nil;
try
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CLASSES_ROOT;
if Reg.OpenKey(Ext, True) then
Result := Reg.ReadString('Content Type');
finally
Reg.CloseKey;
Reg.Free;
end;
end;
{$ENDIF}
{ Determine if a directory exists }
function DirExists(Dir : string): Boolean;
{$IFDEF IP_LAZARUS}
begin
Result:=DirPathExists(Dir);
end;
{$ELSE}
var
Attributes : Integer;
begin
Attributes := GetFileAttributes(PAnsiChar(Dir));
Result := (Attributes <> -1) and
(Attributes and FILE_ATTRIBUTE_DIRECTORY <> 0);
end;
{$ENDIF}
{Begin !!.12}
{ Get temporary filename as string }
function GetTemporaryFile(const Path : string) : string;
{$IFDEF IP_LAZARUS}
begin
Result:=GetTempFileNameUTF8(Path,'IP_');
end;
{$ELSE}
var
TempFileName : array [0..MAX_PATH] of AnsiChar;
begin
{ Create a new uniquely named file in that folder. }
GetTempFileName(PAnsiChar(Path), 'IP_', 0, TempFileName);
Result := TempFileName;
end;
{$ENDIF}
{End !!.12}
{ Get Windows system TEMP path in a string }
function GetTemporaryPath: string;
{$IFDEF IP_LAZARUS}
begin
writeln('ToDo: IpUtils.GetTemporaryPath');
Result:='';
end;
{$ELSE}
var
PathBuf : array [0..MAX_PATH] of char;
begin
GetTempPath(MAX_PATH + 1, PathBuf);
Result := StrPas(PathBuf);
end;
{$ENDIF}
{ Append backslash to DOS path if needed }
function AppendBackSlash(APath : string) : string;
begin
{$IFDEF IP_LAZARUS}
Result := AppendPathDelim(APath);
{$ELSE}
Result := APath;
if (Result <> '') and (Result[Length(APath)] <> '\') then
Result := Result + '\';
{$ENDIF}
end;
{ Remove trailing backslash from a DOS path if needed }
function RemoveBackSlash(APath: string) : string;
begin
{$IFDEF IP_LAZARUS}
Result := ChompPathDelim(APath);
{$ELSE}
Result := APath;
if Result[Length(Result)] = '\' then
Delete(Result, Length(Result), 1);
{$ENDIF}
end;
{***********************************************}
{cookie support}