Updated components, added 2 new units

This commit is contained in:
Christian Hammacher 2005-10-30 10:33:16 +00:00
parent be1475b732
commit fc9e39a021
11 changed files with 2827 additions and 846 deletions

View File

@ -1,8 +1,6 @@
program AMXX_Studio; program AMXX_Studio;
uses uses
madExcept,
madLinkDisAsm,
Forms, Forms,
Windows, Windows,
Classes, Classes,
@ -38,7 +36,8 @@ uses
UnitfrmClose in 'UnitfrmClose.pas' {frmClose}, UnitfrmClose in 'UnitfrmClose.pas' {frmClose},
UnitfrmConnGen in 'UnitfrmConnGen.pas' {frmConnGen}, UnitfrmConnGen in 'UnitfrmConnGen.pas' {frmConnGen},
UnitPlugins in 'UnitPlugins.pas', UnitPlugins in 'UnitPlugins.pas',
UnitfrmIRCPaster in 'UnitfrmIRCPaster.pas' {frmIRCPaster}; UnitfrmIRCPaster in 'UnitfrmIRCPaster.pas' {frmIRCPaster},
MyEditFileClasses in 'MyEditFileClasses.pas';
{ Used components: { Used components:
- JVCL 3.0 - JVCL 3.0

Binary file not shown.

View File

@ -0,0 +1,234 @@
{
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 specificlanguage governing rights and limitations under
the License.
The Original Code is MyEditFileClasses.pas
The Original Code is part of the MyEditor project, written by
Jan Martin Pettersen for the Delphi Scintilla Interface Components
Copyright © 2004,2005, Jan Martin Pettersen. All Rights Reserved.
The Initial Developer of the Original Code is Jan Martin Pettersen
}
{
History: 23/07/2005 Initial Release
}
unit MyEditFileClasses;
interface
uses Classes,SciLexer,UtfFunct,SciStreamDefault;
type
{This code is somewhat a mess at the moment, but it seems to work however..}
TSciMyStream=class(TSciStreamDefault)
protected
FMode : UniMode;
public
constructor Create(Editor : TScintillaBase);override;
procedure SaveToStream(Stream : TStream);override;
procedure LoadFromStream(Stream : TStream);override;
function GetData : Integer;override;
procedure SetData(Value : Integer);override;
end;
implementation
uses SciSupport,SysUtils,Math,sciUtils;
constructor TSciMyStream.Create(Editor : TScintillaBase);
begin
inherited Create(Editor);
FMode:=uni8bit;
end;
procedure TSciMyStream.SaveToStream(Stream : TStream);
var
ms : TMemoryStream;
UniString : String;
UString : PChar;
nullch : AnsiChar;
Writer : UtfWrite;
procedure internalSaveToStream(Stream : TStream);
var
buf : array[0..UniBufSize+1] of Char;
docLen,i : LongInt;
grabSize : LongInt;
rng : TTextRange;
begin
if (not assigned(Stream)) then Exit;
with FEditor do
begin
i:=0;
docLen:=GetLength;
if docLen=0 then Exit;
while i<docLen do
begin
grabSize:=docLen-i;
if grabSize>UniBufSize then
grabSize:=UniBufSize;
rng.chrg.cpMin:=i;
rng.chrg.cpMax:=i+grabSize;
rng.lpstrText:=@buf;
FEditor.GetTextRange(@rng);
Stream.Write(buf,grabSize);
Inc(i,grabSize);
end;
end;
end;
begin
ms:=nil;
Writer:=nil;
if not assigned(FEditor) then Exit;
try
try
Writer:=UtfWrite.Create;
Writer.Encoding:=FMode;
Writer.DestStream:=Stream;
ms:=TMemoryStream.Create;
nullch:=#0;
if FEditor.GetCodePage<>SC_CP_UTF8 then //If the control isn't using the UTF8 format.
begin
if FMode<>uni8bit then //Save in a unicode format
begin
internalSaveToStream(ms); //Save to the memorystream used for conversion
ms.Seek(0,soFromEnd);
ms.Write(nullch,SizeOf(nullch)); //Write ending null, so the memorybuffer can be used as a string
UniString:=AnsiToUTF8(PChar(ms.Memory)); //Convert to UTF8 so the encoder can work with it.
ms.Clear;
UString:=PChar(UniString);
Writer.Write(UString,Length(UString)); //Perform encoding
end else
begin
internalSaveToStream(Stream);
end;
end else //otherwise..
begin
internalSaveToStream(ms); //Save to the memorystream used for conversion
ms.Seek(0,soFromEnd);
ms.Write(nullch,SizeOf(nullch)); //Write ending null, so the memorybuffer can be used as a string
UString:=PChar(ms.Memory);
if FMode=uni8bit then //If we are ordered to save in Ansi,8bit format.
begin
UniString:=UTF8ToAnsi(UString); //Convert the UTF8 retrieved from the control to Ansi
ms.Clear;
UString:=PChar(UniString);
end;
Writer.Write(UString,Length(UString));
end;
except
raise;
end;
finally
if assigned(ms) then FreeAndNil(ms);
if assigned(Writer) then FreeAndNil(Writer);
end;
end;
procedure TSciMyStream.LoadFromStream(Stream : TStream);
var
buf : array[0..UniBufSize+1] of Char;
OldUseUnicode : Boolean;
NumRead,NumCvt : Integer;
Converter: UtfRead;
siz : LongInt;
nbuf : PChar;
oldoffs : Integer;
tmpstr : String;
ms : TMemoryStream;
begin
Converter:=nil;
ms:=nil;
if not assigned(Stream) then Exit;
if not assigned(FEditor) then Exit;
try
try
if Stream.Size>2 then
begin
oldoffs:=Stream.Position;
Stream.Read(buf,3);
DetectEncoding(PByte(@buf),3,FMode); //Detect the encoding used in the file.. uni8bit is returned if unknown/ansi.
Stream.Seek(oldoffs,soFromBeginning);
if FMode<>uni8bit then //If not ansi/unknown
begin
Converter:=UtfRead.Create;
with FEditor do
begin
OldUseUnicode := (FEditor.GetCodePage=SC_CP_UTF8);
siz:=Stream.Size;
if OldUseUnicode=False then
begin
ms:=TMemoryStream.Create; //Create a temporary memorystream to store the utf8 data to be converted to ansi
end;
NumRead:=Stream.Read(buf,Min(siz,UniBufSize));
while (NumRead>0) do
begin
NumCvt:=Converter.Convert(buf,NumRead);
nbuf:=Converter.getNewBuf;
if (assigned(nbuf)) and (NumCvt>0) then
begin
if OldUseUnicode=False then
begin
ms.Write(nbuf^,NumCvt);
end else
FEditor.AddText(NumCvt,nbuf);
end;
NumRead:=Stream.Read(buf,Min(siz,UniBufSize));
Dec(siz,NumRead);
end;
if (OldUseUnicode=False) and (assigned(ms)) then //Do the conversion of the UTF8 data to Ansi
begin
ms.Seek(0,soFromEnd);
buf[0]:=#0; //Write the ending null so we can use the memorybuffer as a string
ms.Write(buf,1);
tmpstr:=UTF8ToAnsi(PChar(ms.Memory));//Convert to ANSI
ms.Clear;
FEditor.AddTextStr(tmpstr);
tmpstr:='';
end;
end;
end else
begin
if FEditor.GetCodePage=SC_CP_UTF8 then //If the editor control is expecting UTF8 and we have Ansi/Unknown data, convert it to UTF8..
begin
ms:=TMemoryStream.Create;
ms.CopyFrom(Stream,0);
ms.Seek(0,soFromEnd);
buf[0]:=#0; //Write the ending null so we can use the memorybuffer as a string
ms.Write(buf,1);
tmpstr:=AnsiToUTF8(PChar(ms.Memory)); //Convert to UTF8
ms.Clear;
nbuf:=PChar(tmpstr);
ms.Write(nbuf^,Length(tmpstr));
ms.Seek(0,soFromBeginning);
inherited LoadFromStream(ms);
end else //Otherwise just call the default loader
inherited LoadFromStream(Stream);
end;
end else //otherwise just call the default loader
inherited LoadFromStream(Stream);
except
raise;
end;
finally
if assigned(Converter) then FreeAndNil(Converter);
if assigned(ms) then FreeAndNil(ms);
end;
end;
function TSciMyStream.GetData : Integer;
begin
Result:=Integer(FMode); //We return the current mode/last mode detected when we loaded a file.
end;
procedure TSciMyStream.SetData(Value : Integer);
begin
FMode:=UniMode(Value); //Sets a new mode
end;
end.

View File

@ -73,6 +73,8 @@ implementation
Uses Uses
SciSearchTextDlg, SciConfirmReplaceDlg, SciReplaceTextDlg, SciSupport,sciUtils; SciSearchTextDlg, SciConfirmReplaceDlg, SciReplaceTextDlg, SciSupport,sciUtils;
var ConfirmReplaceDialog: TConfirmReplaceDialog;
{ TSciSearchReplace } { TSciSearchReplace }
constructor TSciSearchReplace.Create(AOwner : TComponent); constructor TSciSearchReplace.Create(AOwner : TComponent);
begin begin
@ -94,9 +96,11 @@ var
findLen : Integer; findLen : Integer;
LenFound, LenReplaced : Integer; LenFound, LenReplaced : Integer;
// lastMatch : Integer; // lastMatch : Integer;
ConfirmReplaceDialog: TConfirmReplaceDialog;
doendundo : Boolean; doendundo : Boolean;
begin begin
doendundo:=false; doendundo:=false;
ConfirmReplaceDialog := nil;
if not Assigned(FEditor) then Exit; if not Assigned(FEditor) then Exit;
Options := 0; Options := 0;
if SearchCaseSensitive then if SearchCaseSensitive then

View File

@ -4,7 +4,7 @@ interface
uses uses
Classes, Forms, SysUtils, ComCtrls, Windows, ScintillaLanguageManager, Classes, Forms, SysUtils, ComCtrls, Windows, ScintillaLanguageManager,
Dialogs, CommCtrl, madExcept; Dialogs, CommCtrl;
type type
TCodeExplorerUpdater = class(TThread) TCodeExplorerUpdater = class(TThread)
@ -88,7 +88,7 @@ begin
end; end;
except except
if FindWindow(nil, 'Delphi 7') <> 0 then // This is "Debug Mode" if FindWindow(nil, 'Delphi 7') <> 0 then // This is "Debug Mode"
madExcept.HandleException; //madExcept.HandleException;
end; end;
end; end;
Sleep(1000); Sleep(1000);

File diff suppressed because it is too large Load Diff

View File

@ -12,14 +12,15 @@ uses
TBXXitoTheme, TBXMonaiXPTheme, TBXZezioTheme, TBXWhidbeyTheme, TBXXitoTheme, TBXMonaiXPTheme, TBXZezioTheme, TBXWhidbeyTheme,
TBXRomaTheme, TBXMirandaTheme, { <- Themes } TBXRomaTheme, TBXMirandaTheme, { <- Themes }
SpTBXTabs, ExtCtrls, SpTBXDkPanels, TFlatSplitterUnit, SpTBXTabs, ExtCtrls, SpTBXDkPanels, TFlatSplitterUnit,
SciLexer, SciLexerMemo, SciLexerMod, SciCallTips, ComCtrls, mbTBXTreeView, SciLexer, SciLexerMemo, SciLexerMod, SciCallTips, ComCtrls,
StdCtrls, mbTBXRichEdit, TBXDkPanels, TBXToolPals, SciPropertyMgr, StdCtrls, TBXDkPanels, TBXToolPals, SciPropertyMgr,
mbTBXHint, mbTBXHotKeyEdit, SciAutoComplete, sciKeyBindings, SciAutoComplete, sciKeyBindings,
sciPrint, mxFlatControls, ClipBrd, ActnList, SciSearchReplace, sciPrint, ClipBrd, ActnList, SciSearchReplace,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP,
ShellAPI, IdFTPCommon, IdAntiFreezeBase, IdAntiFreeze, JvComponent, ShellAPI, IdFTPCommon, IdAntiFreezeBase, IdAntiFreeze, JvComponent,
JvInspector, JvExControls, JvPluginManager, JvgLanguageLoader, JvInspector, JvExControls, JvPluginManager, JvgLanguageLoader,
JvWndProcHook, CommCtrl, JvPageList, JvPageListTreeView; JvWndProcHook, CommCtrl, JvPageList, JvPageListTreeView,
SciSearchReplaceBase;
type type
TfrmMain = class(TForm) TfrmMain = class(TForm)
@ -378,6 +379,7 @@ type
procedure jviCodeItemValueChanged(Sender: TObject; procedure jviCodeItemValueChanged(Sender: TObject;
Item: TJvCustomInspectorItem); Item: TJvCustomInspectorItem);
procedure mnuRestoreBackupClick(Sender: TObject); procedure mnuRestoreBackupClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private private
procedure UpdateNotes; procedure UpdateNotes;
public public
@ -405,7 +407,7 @@ uses UnitfrmSettings, UnitMainTools, UnitLanguages, UnitfrmInfo,
UnitfrmHudMsgGenerator, UnitCompile, UnitfrmAutoIndent, UnitfrmHudMsgGenerator, UnitCompile, UnitfrmAutoIndent,
UnitfrmHTMLPreview, UnitCodeInspector, UnitfrmMOTDGen, UnitfrmHTMLPreview, UnitCodeInspector, UnitfrmMOTDGen,
UnitfrmMenuGenerator, UnitfrmClose, UnitPlugins, UnitfrmConnGen, UnitfrmMenuGenerator, UnitfrmClose, UnitPlugins, UnitfrmConnGen,
UnitMenuGenerators, UnitfrmIRCPaster; UnitMenuGenerators, UnitfrmIRCPaster, MyEditFileClasses;
{$R *.dfm} {$R *.dfm}
@ -1144,7 +1146,7 @@ end;
procedure TfrmMain.mnuToogleBookmarkClick(Sender: TObject); procedure TfrmMain.mnuToogleBookmarkClick(Sender: TObject);
begin begin
sciEditor.BookmarkToggle(sciEditor.GetCurrentLineNumber); sciEditor.Bookmark.Toggle(sciEditor.GetCurrentLineNumber);
end; end;
procedure TfrmMain.mnuEditorDeleteClick(Sender: TObject); procedure TfrmMain.mnuEditorDeleteClick(Sender: TObject);
@ -1159,7 +1161,7 @@ end;
procedure TfrmMain.mnuGoToBookmarkClick(Sender: TObject); procedure TfrmMain.mnuGoToBookmarkClick(Sender: TObject);
begin begin
sciEditor.BookmarkNext; sciEditor.Bookmark.Next(True);
end; end;
procedure TfrmMain.mnuSearchDialogClick(Sender: TObject); procedure TfrmMain.mnuSearchDialogClick(Sender: TObject);
@ -2859,7 +2861,12 @@ end;
procedure TfrmMain.mnuRestoreBackupClick(Sender: TObject); procedure TfrmMain.mnuRestoreBackupClick(Sender: TObject);
begin begin
if MessageBox(Handle, PChar(lAskRestore), PChar(Application.Title), MB_ICONQUESTION + MB_YESNO) = mrYes then if MessageBox(Handle, PChar(lAskRestore), PChar(Application.Title), MB_ICONQUESTION + MB_YESNO) = mrYes then
sciEditor.LoadFromFile(ActiveDoc.FileName + '.bak'); sciEditor.Lines.LoadFromFile(ActiveDoc.FileName + '.bak');
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
sciEditor.StreamClass := TSciMyStream;
end; end;
end. end.

View File

@ -61,7 +61,7 @@ object frmSettings: TfrmSettings
Top = 0 Top = 0
Width = 353 Width = 353
Height = 260 Height = 260
ActivePage = jspTools ActivePage = jspHighlighter
PropagateEnable = False PropagateEnable = False
Align = alClient Align = alClient
OnChange = jplSettingsChange OnChange = jplSettingsChange

View File

@ -562,12 +562,16 @@ procedure TfrmSettings.cmdBrowsePAWNCompilerClick(Sender: TObject);
begin begin
if odBrowse.Execute then if odBrowse.Execute then
txtPAWNCompilerPath.Text := odBrowse.FileName; txtPAWNCompilerPath.Text := odBrowse.FileName;
txtPawnOutput.OnEnter(Sender);
txtCPPOutput.OnEnter(Sender);
end; end;
procedure TfrmSettings.cmdBrowseCPPCompilerClick(Sender: TObject); procedure TfrmSettings.cmdBrowseCPPCompilerClick(Sender: TObject);
begin begin
if odBrowse.Execute then if odBrowse.Execute then
txtCPPCompilerPath.Text := odBrowse.FileName; txtCPPCompilerPath.Text := odBrowse.FileName;
txtPawnOutput.OnEnter(Sender);
txtCPPOutput.OnEnter(Sender);
end; end;
procedure TfrmSettings.cmdBrowseOutputPAWNClick(Sender: TObject); procedure TfrmSettings.cmdBrowseOutputPAWNClick(Sender: TObject);

608
editor/studio/UtfFunct.PAS Executable file
View File

@ -0,0 +1,608 @@
{
This file is translated to Delphi from the file referenced below
by Jan Martin Pettersen (hdalis@users.sourceforge.net)
23/07/2005.
Some code in this file is also taken from the SciTE (Neil Hodgson)
}
// Utf8_16.cxx
// Copyright (C) 2002 Scott Kirkwood
//
// Permission to use, copy, modify, distribute and sell this code
// and its documentation for any purpose is hereby granted without fee,
// provided that the above copyright notice appear in all copies or
// any derived copies. Scott Kirkwood makes no representations
// about the suitability of this software for any purpose.
// It is provided "as is" without express or implied warranty.
////////////////////////////////////////////////////////////////////////////////
unit UtfFunct;
interface
uses Windows,SysUtils,Classes,Math;
const
UniBufSize=32000;
type
Utf16=Word;
Utf8=Byte;
TUtf8Array=array[0..1] of Utf8;
PUtf8=^TUtf8Array;
TUtf16Array=array[0..1] of Utf16;
PUtf16=^TUtf16Array;
//uniCookie isn't used yet..
UniMode=(uni8Bit, uni16BE, uni16LE, uniUTF8,uniCookie);
//States for the unicode Next functions..
eState=(eStart,e2Bytes2,e3Bytes2,e3Bytes3);
// Reads UTF-16 and outputs UTF-8
Utf16_Iter=class(TObject)
private
m_eEncoding : UniMode;
m_eState : eState;
m_pBuf : PByte;
m_pRead : PByte;
m_pEnd : PByte;
m_nCur : Utf8;
m_nCur16 : Utf16;
public
constructor Create;
procedure Reset;
procedure Set_(const pbuf : PByte;nLen : Cardinal;eEncoding : UniMode);
function More : Boolean;
procedure Next;
function Get : Utf8;
end;
// Reads UTF-8 and outputs UTF-16
Utf8_Iter =class(TObject)
private
m_eEncoding : UniMode;
m_eState : eState;
m_pBuf : PByte;
m_pRead : PByte;
m_pEnd : PByte;
m_nCur16 : Utf16;
procedure toStart;
procedure Swap;
public
constructor Create;
procedure Reset;
procedure Set_(const pbuf : PByte;nLen : Cardinal;eEncoding : UniMode);
function More : Boolean; //bool
procedure Next;
function Get : Utf16;
function canGet : Boolean;
end;
// Reads UTF16 and outputs UTF8
UtfRead=class(TObject)
private
m_eEncoding : UniMode;
m_pBuf : PByte;
m_nBufSize : Cardinal;
m_bFirstRead : Boolean;
m_pNewBuf : PByte;
m_nLen : Cardinal;
m_Iter16 : Utf16_Iter;
public
constructor Create;
destructor Destroy;override;
function getEncoding : UniMode;
function getNewBuf : PChar;
function Convert(buf : PChar; len : Cardinal) : Cardinal;
procedure Reset;
property Encoding : UniMode read m_eEncoding;
end;
// Read in a UTF-8 buffer and write out to UTF-16 or UTF-8
UtfWrite=class(TObject)
private
m_eEncoding : UniMode;
m_pBuf : PUtf16;
m_nBufSize : Cardinal;
m_bFirstWrite : Boolean;
m_pFile : TStream;
procedure SetDestStream(Value : TStream);
procedure SetEncoding(eType : UniMode);
public
constructor Create;
function Write(const Buffer; Count : Cardinal) : LongInt;
property DestStream : TStream read m_pFile write SetDestStream;
property Encoding : UniMode read m_eEncoding write SetEncoding;
end;
//Returns the UTF8 length of the buffer 'uptr'.
function UTF8Length(const wideSrc : PWideChar; wideLen : Cardinal) : Cardinal;
//Transforms UCS2 to UTF8.
procedure UTF8FromUCS2(const wideSrc : PWideChar; wideLen : Cardinal; utfDestBuf : PChar; utfDestLen : Cardinal);
function UTF8ToAnsiP(const srcBuffer : PChar;len : Integer;destBuffer : PChar) : Integer;
function DetectEncoding(buf : PByte;len : Integer;var Encoding : UniMode) : Integer;
implementation
const
k_boms : array[uni8bit..uniUTF8,0..2] of Utf8=(
($00,$00,$00),
($FE,$FF,$00),
($FF,$FE,$00),
($EF,$BB,$BF));
function UTF8ToAnsiP(const srcBuffer : PChar;len : Integer;destBuffer : PChar) : Integer;
var
tmpbuffer : String;
srcLen,i,destLen : Integer;
begin
Result:=0;
if (not assigned(srcBuffer)) or (not assigned(destBuffer)) then Exit;
if len=-1 then
srcLen:=Length(srcBuffer)
else
srcLen:=len;
tmpbuffer:=UTF8ToAnsi(Copy(srcBuffer,1,srcLen));
destLen:=Length(tmpbuffer);
for i:=1 to destLen do
destBuffer[i-1]:=tmpbuffer[i];
destBuffer[destLen]:=#0;
Result:=destLen;
end;
function UTF8Length(const wideSrc : PWideChar; wideLen : Cardinal) : Cardinal;
var
i,len : Cardinal;
uch : Cardinal;
begin
len := 0;
i:=0;
while((i<wideLen) and (Cardinal(wideSrc[i])<>0)) do
begin
uch:=Cardinal(wideSrc[i]);
if (uch < $80) then
Inc(len)
else if (uch < $800) then
Inc(len,2)
else
Inc(len,3);
Inc(i);
end;
Result:=len;
end;
procedure UTF8FromUCS2(const wideSrc : PWideChar; wideLen : Cardinal; utfDestBuf : PChar; utfDestLen : Cardinal);
var
k : Integer;
i : Cardinal;
uch : Cardinal;
begin
k:= 0;
i:=0;
while((i<wideLen)and(Cardinal(wideSrc[i])<>0)) do
begin
uch:=Cardinal(wideSrc[i]);
if uch<$80 then
begin
utfDestBuf[k] := Char(uch);
Inc(k);
end else
if (uch<$800) then
begin
utfDestBuf[k]:=Char($C0 or (uch shr 6));
Inc(k);
utfDestBuf[k] := Char($80 or (uch and $3f));
Inc(k);
end else
begin
utfDestBuf[k] := Char($E0 or (uch shr 12));
Inc(k);
utfDestBuf[k] := Char($80 or ((uch shr 6) and $3f));
Inc(k);
utfDestBuf[k] := Char($80 or (uch and $3f));
Inc(k);
end;
end;
utfDestBuf[utfDestLen]:=#0;
end;
function DetectEncoding(buf : PByte;len : Integer;var Encoding : UniMode) : Integer;
var
nRet : Integer;
pbTmp : PByteArray;
begin
Encoding := uni8bit;
pbTmp:=PByteArray(buf);
nRet := 0;
if (len > 1) then
begin
if ((pbTmp[0]=k_Boms[uni16BE][0]) and (pbTmp[1]=k_Boms[uni16BE][1])) then
begin
Encoding := uni16BE;
nRet := 2;
end else
if ((pbTmp[0]=k_Boms[uni16LE][0]) and (pbTmp[1]=k_Boms[uni16LE][1])) then
begin
Encoding := uni16LE;
nRet := 2;
end else
if ((len>2) and (pbTmp[0]=k_Boms[uniUTF8][0]) and (pbTmp[1]=k_Boms[uniUTF8][1]) and (pbTmp[2]=k_Boms[uniUTF8][2])) then
begin
Encoding := uniUTF8;
nRet := 3;
end;
end;
Result:=nRet;
end;
constructor Utf16_Iter.Create;
begin
Reset;
end;
procedure Utf16_Iter.Reset;
begin
m_pBuf := nil;
m_pRead := nil;
m_pEnd := nil;
m_eState := eStart;
m_nCur := 0;
m_nCur16 := 0;
m_eEncoding := uni8bit;
end;
procedure Utf16_Iter.Set_(const pbuf : PByte;nLen : Cardinal;eEncoding : UniMode);
begin
m_pBuf := pBuf;
m_pRead := pBuf;
m_pEnd := pBuf;
Inc(m_pEnd,nLen);
m_eEncoding := eEncoding;
Next;
end;
procedure Utf16_Iter.Next;
begin
case m_eState of
eStart:
begin
if (m_eEncoding = uni16LE) then
begin
m_nCur16 := Utf16(m_pRead^);
Inc(m_pRead);
m_nCur16 := m_nCur16 or Utf16((m_pRead^ shl 8));
end else
begin
m_nCur16 := Utf16(m_pRead^ shl 8);
Inc(m_pRead);
m_nCur16 := m_nCur16 or m_pRead^;
end;
Inc(m_pRead);
if (m_nCur16 < $80) then
begin
m_nCur := Byte(m_nCur16 and $FF);
m_eState := eStart;
end else
if (m_nCur16 < $800) then
begin
m_nCur := Byte($C0 or (m_nCur16 shr 6));
m_eState := e2Bytes2;
end else
begin
m_nCur := Byte($E0 or (m_nCur16 shr 12));
m_eState := e3Bytes2;
end;
end;
e2Bytes2:
begin
m_nCur := Byte($80 or (m_nCur16 and $3F));
m_eState := eStart;
end;
e3Bytes2:
begin
m_nCur := Byte($80 or ((m_nCur16 shr 6) and $3F));
m_eState := e3Bytes3;
end;
e3Bytes3:
begin
m_nCur := Byte($80 or (m_nCur16 and $3F));
m_eState := eStart;
end;
end;
end;
function Utf16_Iter.More : Boolean;
begin
Result:=Cardinal(m_pRead) <= Cardinal(m_pEnd);
end;
function Utf16_Iter.Get : Utf8;
begin
Result:=m_nCur;
end;
constructor Utf8_Iter.Create;
begin
Reset;
end;
procedure Utf8_Iter.Reset;
begin
m_pBuf := nil;
m_pRead := nil;
m_pEnd := nil;
m_eState := eStart;
m_nCur16 := 0;
m_eEncoding := uni8bit;
end;
procedure Utf8_Iter.Set_(const pbuf : PByte;nLen : Cardinal;eEncoding : UniMode);
begin
m_pBuf := pBuf;
m_pRead := pBuf;
m_pEnd := pBuf;
Inc(m_pEnd,nLen);
m_eEncoding := eEncoding;
Next;
end;
procedure Utf8_Iter.Next;
begin
case (m_eState) of
eStart:
begin
if (($E0 and m_pRead^) = $E0) then
begin
m_nCur16 := Utf16(((not $E0) and m_pRead^) shl 12);
m_eState := e3Bytes2;
end else if (($C0 and m_pRead^) = $C0) then
begin
m_nCur16 := Utf16((not $C0 and m_pRead^) shl 6);
m_eState := e2Bytes2;
end else
begin
m_nCur16 := m_pRead^;
toStart;
end;
end;
e2Bytes2:
begin
m_nCur16 :=m_nCur16 or utf8($3F and m_pRead^);
toStart;
end;
e3Bytes2:
begin
m_nCur16 :=m_nCur16 or utf16(($3F and m_pRead^) shl 6);
m_eState := e3Bytes3;
end;
e3Bytes3:
begin
m_nCur16 :=m_nCur16 or utf8($3F and m_pRead^);
toStart;
end;
end;
Inc(m_pRead);
end;
function Utf8_Iter.More : Boolean;
begin
Result:=Cardinal(m_pRead) <= Cardinal(m_pEnd);
end;
function Utf8_Iter.Get : Utf16;
begin
Result:=m_nCur16;
end;
function Utf8_Iter.canGet : Boolean;
begin
Result:=m_eState = eStart;
end;
procedure Utf8_Iter.toStart;
begin
m_eState := eStart;
if (m_eEncoding = uni16BE) then
Swap;
end;
procedure Utf8_Iter.Swap;
var
p : PUtf8;
swapbyte : Utf8;
begin
p := PUtf8(@m_nCur16);
swapbyte := p[0];
p[0]:= p[1];
p[1]:=swapbyte;
end;
constructor UtfRead.Create;
begin
m_eEncoding := uni8bit;
m_nBufSize := 0;
m_pNewBuf := nil;
m_bFirstRead := True;
end;
destructor UtfRead.Destroy;
begin
if ((m_eEncoding <> uni8bit) and (m_eEncoding <> uniUTF8)) then
begin
if assigned(m_pNewBuf) then FreeMem(m_pNewBuf);
end;
inherited;
end;
function UtfRead.getEncoding : UniMode;
begin
Result:=m_eEncoding;
end;
function UtfRead.getNewBuf : PChar;
begin
Result:=PChar(m_pNewBuf);
end;
procedure UtfRead.Reset;
begin
m_bFirstRead:=True;
m_nBufSize:=0;
m_eEncoding :=uni8Bit;
end;
function UtfRead.Convert(buf : PChar; len : Cardinal) : Cardinal;
var
nSkip : Cardinal;
newSize : Cardinal;
pCur,pTemp : PByte;
begin
m_Iter16:=Utf16_Iter.Create;
try
m_pBuf := PByte(buf);
m_nLen := len;
nSkip := 0;
if (m_bFirstRead) then
begin
nSkip := DetectEncoding(m_pBuf,m_nLen,m_eEncoding);
m_bFirstRead := False;
end;
if (m_eEncoding = uni8bit) then
begin
// Do nothing, pass through
m_nBufSize := 0;
m_pNewBuf := m_pBuf;
Result:=len;
Exit;
end;
if (m_eEncoding = uniUTF8) then
begin
// Pass through after BOM
m_nBufSize := 0;
m_pNewBuf := m_pBuf;
Inc(m_pNewBuf,nSkip);
Result:=len - nSkip;
Exit;
end;
// Else...
//newSize := len + len div 2 + 1;
newSize:=len*2+1;
if (m_nBufSize <> newSize) then
begin
FreeMem(m_pNewBuf);
m_pNewBuf:=nil;
GetMem(m_pNewBuf,newSize);
m_nBufSize := newSize;
end;
pCur := m_pNewBuf;
pTemp:=m_pBuf;
Inc(pTemp,nSkip);
m_Iter16.Set_(pTemp, len - nSkip, m_eEncoding);
while(m_Iter16.More) do
begin
pCur^:=m_Iter16.Get;
Inc(PCur);
m_Iter16.Next;
end;
// Return number of bytes writen out
finally
FreeAndNil(m_Iter16);
end;
Result:=Cardinal(pCur) - Cardinal(m_pNewBuf);
end;
constructor UtfWrite.Create;
begin
m_eEncoding := uni8bit;
m_pFile := nil;
m_pBuf := nil;
m_bFirstWrite := true;
m_nBufSize := 0;
end;
procedure UtfWrite.SetEncoding(eType : UniMode);
begin
m_eEncoding := eType;
end;
procedure UtfWrite.SetDestStream(Value : TStream);
begin
m_pFile:=Value;
m_bFirstWrite:=True;
end;
function UtfWrite.Write(const Buffer; Count : Cardinal) : LongInt;
var
iter8 : Utf8_Iter;
pCur : ^Utf16;
ret : LongInt;
pTemp : PChar;
begin
if Count=0 then
begin
Result:=0;
Exit;
end;
iter8:=Utf8_Iter.Create;
try
if (not assigned(m_pFile)) then
begin
Result:=0;
Exit;
end;
if (m_eEncoding = uni8bit) then
begin
// Normal write
m_bFirstWrite:=False;
Result:=m_pFile.Write(PChar(Buffer)^, Count);
Exit;
end;
if (m_eEncoding = uniUTF8) then
begin
pTemp:=PChar(Buffer);
if (m_bFirstWrite) then
begin
m_pFile.Write(k_Boms[m_eEncoding], 3);
m_bFirstWrite := false;
end;
Result:=m_pFile.Write(pTemp^, Count);
Exit;
end;
if (Count > m_nBufSize) then
begin
m_nBufSize := Count;
if assigned(m_pBuf) then FreeMem(m_pBuf);
m_pBuf := nil;
GetMem(m_pBuf,SizeOf(Utf16)*(Count+1));
end;
if (m_bFirstWrite) then
begin
if ((m_eEncoding = uni16BE) or (m_eEncoding = uni16LE)) then
begin
// Write the BOM
m_pFile.Write(k_Boms[m_eEncoding],2);
end;
m_bFirstWrite := false;
end;
iter8.set_(PByte(Buffer), Count, m_eEncoding);
pCur := @m_pBuf[0];
while(iter8.More) do
begin
if (iter8.canGet) then
begin
pCur^ := iter8.Get;
Inc(pCur);
end;
iter8.Next;
end;
ret := m_pFile.Write(m_pBuf^,Cardinal(pCur)-Cardinal(m_pBuf));
finally
if assigned(iter8) then FreeAndNil(iter8);
end;
Result:=ret;
end;
end.

BIN
editor/studio/upx.exe Executable file

Binary file not shown.