pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

systools: Rearrange units and packages

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6159 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-01-30 16:17:37 +00:00
parent f6fdbc97c6
commit 543cdf06d9
117 changed files with 739 additions and 285 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/systools/source/windows_only/run/stgenlog.pas
View File

@ -254,7 +254,7 @@ begin
FLogFileHeader := StLogFileHeader;
HighLevel := StDefHighLevel;
glHighLevelTriggered := False;
glTimeBase := GetTickCount;
glTimeBase := GetTickCount64;
end;
destructor TStGeneralLog.Destroy;
@ -309,7 +309,7 @@ begin
{ Bail if we're not logging }
if not Enabled then Exit;
TimeMrk := GetTickCount;
TimeMrk := GetTickCount64;
{ Determine size needed }
SizeReq := SizeOf(TStLogRec);
@ -495,7 +495,7 @@ begin
{ Copy second half }
Move(glBuffer[0], glTempBuffer[ChunkSize], (LogRec.lrData4 - ChunkSize));
LogRec.lrData3 := DWORD(@glTempBuffer[0]);
LogRec.lrData3 := DWORD(PtrInt((@glTempBuffer[0])));
glBufferHead := LogRec.lrData4 - ChunkSize;
end;
end

175
components/systools/source/windows_only/run/sttext.pas
View File

@ -1,175 +0,0 @@
// Upgraded to Delphi 2009: Sebastian Zierer
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower SysTools
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{*********************************************************}
{* SysTools: StText.pas 4.04 *}
{*********************************************************}
{* SysTools: Routines for manipulating Delphi Text files *}
{*********************************************************}
{$IFDEF FPC}
{$mode DELPHI}
{$ENDIF}
{$I StDefine.inc}
unit StText;
interface
uses
Windows,
SysUtils, STConst, StBase, StSystem;
function TextSeek(var F : TextFile; Target : LongInt) : Boolean;
{-Seek to the specified position in a text file opened for input}
function TextFileSize(var F : TextFile) : LongInt;
{-Return the size of a text file}
function TextPos(var F : TextFile) : LongInt;
{-Return the current position of the logical file pointer (that is,
the position of the physical file pointer, adjusted to account for
buffering)}
function TextFlush(var F : TextFile) : Boolean;
{-Flush the buffer(s) for a text file}
implementation
function TextSeek(var F : TextFile; Target : LongInt) : Boolean;
{-Do a Seek for a text file opened for input. Returns False in case of I/O
error.}
var
Pos : LongInt;
begin
with TTextRec(F) do begin
{assume failure}
Result := False;
{check for file opened for input}
if Mode <> fmInput then Exit;
Pos := FileSeek(Handle, 0, FILE_CURRENT);
if Pos = -1 then Exit;
Dec(Pos, BufEnd);
{see if the Target is within the buffer}
Pos := Target-Pos;
if (Pos >= 0) and (Pos < LongInt(BufEnd)) then
{it is--just move the buffer pointer}
BufPos := Pos
else begin
if FileSeek(Handle, Target, FILE_BEGIN) = -1 then Exit;
{tell Delphi its buffer is empty}
BufEnd := 0;
BufPos := 0;
end;
end;
{if we get to here we succeeded}
Result := True;
end;
function TextFileSize(var F : TextFile) : LongInt;
{-Return the size of text file F. Returns -1 in case of I/O error.}
var
Old : LongInt;
Res : LongInt;
begin
Result := -1;
with TTextRec(F) do begin
{check for open file}
if Mode = fmClosed then Exit;
{get/save current pos of the file pointer}
Old := FileSeek(Handle, 0, FILE_CURRENT);
if Old = -1 then Exit;
{have OS move to end-of-file}
Res := FileSeek(Handle, 0, FILE_END);
if Res = -1 then Exit;
{reset the old position of the file pointer}
if FileSeek(Handle, Old, FILE_BEGIN) = - 1 then Exit;
end;
Result := Res;
end;
function TextPos(var F : TextFile) : LongInt;
{-Return the current position of the logical file pointer (that is,
the position of the physical file pointer, adjusted to account for
buffering). Returns -1 in case of I/O error.}
var
Position : LongInt;
begin
Result := -1;
with TTextRec(F) do begin
{check for open file}
if Mode = fmClosed then Exit;
Position := FileSeek(Handle, 0, FILE_CURRENT);
if Position = -1 then Exit;
end;
with TTextRec(F) do
if Mode = fmOutput then {writing}
Inc(Position, BufPos)
else if BufEnd <> 0 then {reading}
Dec(Position, BufEnd-BufPos);
{return the calculated position}
Result := Position;
end;
function TextFlush(var F : TextFile) : Boolean;
{-Flush the buffer(s) for a text file. Returns False in case of I/O error.}
var
Position : LongInt;
Code : Integer;
begin
Result := False;
with TTextRec(F) do begin
{check for open file}
if Mode = fmClosed then Exit;
{see if file is opened for reading or writing}
if Mode = fmInput then begin
{get current position of the logical file pointer}
Position := TextPos(F);
{exit in case of I/O error}
if Position = -1 then Exit;
if FileSeek(Handle, Position, FILE_BEGIN) = - 1 then Exit;
end
else begin
{write the current contents of the buffer, if any}
if BufPos <> 0 then begin
Code := FileWrite(Handle, BufPtr^, BufPos);
if Code = -1 {<> 0} then Exit;
end;
{flush OS's buffers}
if not FlushOsBuffers(Handle) then Exit;
end;
{tell Delphi its buffer is empty}
BufEnd := 0;
BufPos := 0;
end;
{if we get to here we succeeded}
Result := True;
end;
end.

6
components/systools/source/windows_only/run/stwmdcpy.pas
View File

@ -117,9 +117,9 @@ begin
Exit;
if Value then begin
PrevWndProc:= Pointer(
SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, LongInt(NewWndProc)))
SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, PtrInt(NewWndProc)))
end else if Assigned(PrevWndProc) then begin
SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, LongInt(PrevWndProc));
SetWindowLong(TForm(Owner).Handle, GWL_WNDPROC, PtrInt(PrevWndProc));
PrevWndProc := nil;
end;
end;
@ -131,7 +131,7 @@ var
begin
with Msg do begin
if (Msg = WM_COPYDATA) then begin
CDS := PCopyDataStruct(Pointer(lParam))^;
CDS := PCopyDataStruct(Pointer(PtrInt(lParam)))^;
if (CDS.dwData = WMCOPYID) then begin
if (Assigned(FOnDataReceived)) then
FOnDataReceived(Self, CDS);