unit YofUtils;
+{
+ HttpApp \82Ì\83N\83\8d\81[\83\93\82â\82»\82Ì\91¼\8eG\97p\8aÖ\90\94
+}
interface
//==================================================
uses
//==================================================
- {$IFDEF LINUX}
- QForms,
- {$ENDIF}
- {$IFDEF MSWINDOWS}
- Windows, ShellApi, Forms,
- {$ENDIF}
- Classes, SysUtils, DateUtils;
-
-//==================================================
-type
-//==================================================
-
- // \82í\82¯\82í\82©\82ç\82¸\8dì\82Á\82Ä\82é\82©\82ç\83o\83O\82¾\82ç\82¯\82©\82à
- XMLDictionary = Record
- Name : string;
- Value : string;
- end;
-
- IXMLNode = class
- private
- FNodeName : string;
- FCount : Integer;
- FAttributeCount : Integer;
- FChildNodes : IXMLNode;
- FNodes : array of IXMLNode;
- FAttributes : array of XMLDictionary;
- function GetAttribute( const Name : string ) : string;
- function GetNode( Index : Integer ) : IXMLNode;
- public
- constructor Create;
-
- property NodeName : string read FNodeName write FNodeName;
- property Attributes[ const Name : string ] : string read GetAttribute;
- property Node[ Index : Integer ] : IXMLNode read GetNode; default;
- property ChildNodes : IXMLNode read FChildNodes write FChildNodes;
- property Count : Integer read FCount write FCount;
- procedure Add( node : IXMLNode );
- procedure AddAttribute( const Name : string; const Value : string );
- end;
-
- IXMLDocument = class( IXMLNode )
- private
- function GetDocumentElement() : IXMLNode;
- public
- property DocumentElement : IXMLNode read GetDocumentElement;
- end;
-
- CryptBlock = record
- b_data : array [0..63] of char;
- end;
- PCryptBlock = ^CryptBlock;
-
- CryptOrdering = record
- o_data : array [0..63] of char;
- end;
-
- CryptData = record
- Key : CryptBlock;
- EP : ^CryptOrdering;
- end;
+ Classes, SysUtils;
procedure ExtractHttpFields(
- const chrSep : TSysCharSet;
- const chrWhite : TSysCharSet;
- const strValue : string;
- var strResult : TStringList;
- unknownFlag : boolean = false );
+ const chrSep : TSysCharSet;
+ const chrWhite : TSysCharSet;
+ const strValue : string;
+ var strResult : TStringList;
+ unknownFlag : boolean = false
+);
function HtmlEncode(
- const strValue : string
- ) : string;
+ const strValue : string
+) : string;
function HtmlDecode(
- const strValue : string
- ) : string;
+ const strValue : string
+) : string;
function HttpEncode(
- const strValue : string
- ) : string;
-
-function MatchesMask(
- const filename, mask : string
- ) : boolean;
+ const strValue : string
+) : string;
-procedure FileThruUntil(
- var f : TFileStream;
- const untilSet : TSysCharSet
-);
+function HttpDecode(
+ const strValue : string
+) : string;
-procedure FileThruWhile(
- var f : TFileStream;
- const whileSet : TSysCharSet
-);
+function MatchesMask(
+ const filename, mask : string
+) : boolean;
-function XMLCloseCheck(
- var f : TFileStream;
- var node : IXMLNode;
- ch : char;
- out tag : string;
- out closed : boolean // \8cÄ\82Ñ\8fo\82µ\82½\83\8b\81[\83`\83\93\82ª node \82ð\95Â\82¶\82é\82×\82«\82È\82ç true
-) : boolean; // ch \82ð\82±\82Ì\83\8b\81[\83`\83\93\82ª\8f\88\97\9d\82µ\82½\82È\82ç true
-
-function XMLReadNode(
- var f : TFileStream;
- var node : IXMLNode
-) : string; // node \88È\8aO\82Ì\83m\81[\83h\82ª\95Â\82¶\82ç\82ê\82½\8fê\8d\87\82Ì\83m\81[\83h\96¼
-
-function LoadXMLDocument(
- const fileName : string
- ) : IXMLDocument;
-
-function get_2ch_trip(
- const pw : PChar
+// \83\81\83^\83L\83\83\83\89\83N\83^\82ð\90³\8bK\95\\8c»\88µ\82¢\82É\82È\82ç\82È\82¢\82æ\82¤\82É\92u\8a·
+function RegExpEncode(
+ const text : string
) : string;
//==================================================
const
//==================================================
- kXMLWhite : TSysCharSet = [#0..#$20];
- kXMLDQuote : TSysCharSet = ['"'];
- kXMLTagStart : TSysCharSet = ['<'];
- kXMLTagEnd : TSysCharSet = ['>'];
- kXMLKanji : TSysCharSet = [#$80..#$A0, #$E0..#$ff];
- kCryptInitialTr : CryptOrdering = ( o_data: (
- #58,#50,#42,#34,#26,#18,#10, #2,#60,#52,#44,#36,#28,#20,#12, #4,
- #62,#54,#46,#38,#30,#22,#14, #6,#64,#56,#48,#40,#32,#24,#16, #8,
- #57,#49,#41,#33,#25,#17, #9, #1,#59,#51,#43,#35,#27,#19,#11, #3,
- #61,#53,#45,#37,#29,#21,#13, #5,#63,#55,#47,#39,#31,#23,#15, #7
- ) );
-
- kCryptFinalTr : CryptOrdering = ( o_data: (
- #40, #8,#48,#16,#56,#24,#64,#32,#39, #7,#47,#15,#55,#23,#63,#31,
- #38, #6,#46,#14,#54,#22,#62,#30,#37, #5,#45,#13,#53,#21,#61,#29,
- #36, #4,#44,#12,#52,#20,#60,#28,#35, #3,#43,#11,#51,#19,#59,#27,
- #34, #2,#42,#10,#50,#18,#58,#26,#33, #1,#41, #9,#49,#17,#57,#25
- ) );
-
- kCryptSwap : CryptOrdering = ( o_data: (
- #33,#34,#35,#36,#37,#38,#39,#40,#41,#42,#43,#44,#45,#46,#47,#48,
- #49,#50,#51,#52,#53,#54,#55,#56,#57,#58,#59,#60,#61,#62,#63,#64,
- #1, #2, #3, #4, #5, #6, #7, #8, #9,#10,#11,#12,#13,#14,#15,#16,
- #17,#18,#19,#20,#21,#22,#23,#24,#25,#26,#27,#28,#29,#30,#31,#32
- ) );
-
- kCryptKeyTr1 : CryptOrdering = ( o_data: (
- #57, #49, #41, #33, #25, #17, #9, #1, #58, #50, #42, #34, #26, #18,
- #10, #2, #59, #51, #43, #35, #27, #19, #11, #3, #60, #52, #44, #36,
- #63, #55, #47, #39, #31, #23, #15, #7, #62, #54, #46, #38, #30, #22,
- #14, #6, #61, #53, #45, #37, #29, #21, #13, #5, #28, #20, #12, #4,
- #0, #0, #0, #0, #0, #0, #0, #0
- ) );
-
- kCryptKeyTr2 : CryptOrdering = ( o_data: (
- #14,#17,#11,#24, #1, #5, #3,#28,#15, #6,#21,#10,
- #23,#19,#12, #4,#26, #8,#16, #7,#27,#20,#13, #2,
- #41,#52,#31,#37,#47,#55,#30,#40,#51,#45,#33,#48,
- #44,#49,#39,#56,#34,#53,#46,#42,#50,#36,#29,#32,
- #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
- #0, #0, #0, #0
- ) );
-
- kCryptEtr : CryptOrdering = ( o_data: (
- #32, #1, #2, #3, #4, #5, #4, #5, #6, #7, #8, #9,
- #8, #9,#10,#11,#12,#13,#12,#13,#14,#15,#16,#17,
- #16,#17,#18,#19,#20,#21,#20,#21,#22,#23,#24,#25,
- #24,#25,#26,#27,#28,#29,#28,#29,#30,#31,#32, #1,
- #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
- #0, #0, #0, #0
- ) );
-
- kCryptPtr : CryptOrdering = ( o_data: (
- #16, #7,#20,#21,#29,#12,#28,#17, #1,#15,#23,#26, #5,#18,#31,#10,
- #2, #8,#24,#14,#32,#27, #3, #9,#19,#13,#30, #6,#22,#11, #4,#25,
- #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
- #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0, #0
- ) );
-
- kCryptS_boxes : array [ 0..7, 0..63 ] of Char = (
- ( #14, #4,#13, #1, #2,#15,#11, #8, #3,#10, #6,#12, #5, #9, #0, #7,
- #0,#15, #7, #4,#14, #2,#13, #1,#10, #6,#12,#11, #9, #5, #3, #8,
- #4, #1,#14, #8,#13, #6, #2,#11,#15,#12, #9, #7, #3,#10, #5, #0,
- #15,#12, #8, #2, #4, #9, #1, #7, #5,#11, #3,#14,#10, #0, #6,#13
- ),
-
- ( #15, #1, #8,#14, #6,#11, #3, #4, #9, #7, #2,#13,#12, #0, #5,#10,
- #3,#13, #4, #7,#15, #2, #8,#14,#12, #0, #1,#10, #6, #9,#11, #5,
- #0,#14, #7,#11,#10, #4,#13, #1, #5, #8,#12, #6, #9, #3, #2,#15,
- #13, #8,#10, #1, #3,#15, #4, #2,#11, #6, #7,#12, #0, #5,#14, #9
- ),
-
- ( #10, #0, #9,#14, #6, #3,#15, #5, #1,#13,#12, #7,#11, #4, #2, #8,
- #13, #7, #0, #9, #3, #4, #6,#10, #2, #8, #5,#14,#12,#11,#15, #1,
- #13, #6, #4, #9, #8,#15, #3, #0,#11, #1, #2,#12, #5,#10,#14, #7,
- #1,#10,#13, #0, #6, #9, #8, #7, #4,#15,#14, #3,#11, #5, #2,#12
- ),
-
- ( #7,#13,#14, #3, #0, #6, #9,#10, #1, #2, #8, #5,#11,#12, #4,#15,
- #13, #8,#11, #5, #6,#15, #0, #3, #4, #7, #2,#12, #1,#10,#14, #9,
- #10, #6, #9, #0,#12,#11, #7,#13,#15, #1, #3,#14, #5, #2, #8, #4,
- #3,#15, #0, #6,#10, #1,#13, #8, #9, #4, #5,#11,#12, #7, #2,#14
- ),
-
- ( #2,#12, #4, #1, #7,#10,#11, #6, #8, #5, #3,#15,#13, #0,#14, #9,
- #14,#11, #2,#12, #4, #7,#13, #1, #5, #0,#15,#10, #3, #9, #8, #6,
- #4, #2, #1,#11,#10,#13, #7, #8,#15, #9,#12, #5, #6, #3, #0,#14,
- #11, #8,#12, #7, #1,#14, #2,#13, #6,#15, #0, #9,#10, #4, #5, #3
- ),
-
- ( #12, #1,#10,#15, #9, #2, #6, #8, #0,#13, #3, #4,#14, #7, #5,#11,
- #10,#15, #4, #2, #7,#12, #9, #5, #6, #1,#13,#14, #0,#11, #3, #8,
- #9,#14,#15, #5, #2, #8,#12, #3, #7, #0, #4,#10, #1,#13,#11, #6,
- #4, #3, #2,#12, #9, #5,#15,#10,#11,#14, #1, #7, #6, #0, #8,#13
- ),
-
- ( #4,#11, #2,#14,#15, #0, #8,#13, #3,#12, #9, #7, #5,#10, #6, #1,
- #13, #0,#11, #7, #4, #9, #1,#10,#14, #3, #5,#12, #2,#15, #8, #6,
- #1, #4,#11,#13,#12, #3, #7,#14,#10,#15, #6, #8, #0, #5, #9, #2,
- #6,#11,#13, #8, #1, #4,#10, #7, #9, #5, #0,#15,#14, #2, #3,#12
- ),
-
- ( #13, #2, #8, #4, #6,#15,#11, #1,#10, #9, #3,#14, #5, #0,#12, #7,
- #1,#15,#13, #8,#10, #3, #7, #4,#12, #5, #6,#11, #0,#14, #9, #2,
- #7,#11, #4, #1, #9,#12,#14, #2, #0, #6,#10,#13,#15, #3, #5, #8,
- #2, #1,#14, #7, #4,#10, #8,#13,#15,#12, #9, #0, #3, #5, #6,#11
- )
- );
-
- kCryptRots : array [ 0..15 ] of Integer = (
- 1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1
- );
+ kYofKanji : TSysCharSet = [#$80..#$A0, #$E0..#$ff];
//==================================================
implementation
//==================================================
-// Constructor
-constructor IXMLNode.Create();
-begin
- FCount := 0;
-end;
-
-function IXMLNode.GetAttribute( const Name : string ) : string;
-var
- i : Integer;
-begin
- i := 0;
- while i < FAttributeCount do
- begin
- if Name = FAttributes[ i ].Name then
- begin
- Result := FAttributes[ i ].Value;
- exit;
- end;
-
- Inc( i );
- end;
-end;
-
-function IXMLNode.GetNode( Index : Integer ) : IXMLNode;
-begin
- Result := FNodes[ Index ];
-end;
-
-procedure IXMLNode.Add( node : IXMLNode );
-begin
- Inc( FCount );
- SetLength( FNodes, FCount );
- FNodes[ FCount - 1 ] := node;
-end;
-
-procedure IXMLNode.AddAttribute(
- const Name : string;
- const Value : string
-);
-var
- index : Integer;
-begin
- index := FAttributeCount;
- Inc( FAttributeCount );
- SetLength( FAttributes, FAttributeCount );
- FAttributes[ index ].Name := Name;
- FAttributes[ index ].Value := Value;
-end;
-
-function IXMLDocument.GetDocumentElement() : IXMLNode;
-begin
- Result := FChildNodes[ 0 ];
-end;
-
// \82Æ\82è\82 \82¦\82¸\82Ì\91ã\97p\95i\82È\82Ì\82Å chrWhite \82ð\8dl\97¶\82µ\82Ä\82¢\82È\82¢\82±\82Æ\82É\92\8d\88Ó\81I\81I\81I
procedure ExtractHttpFields(
- const chrSep : TSysCharSet;
- const chrWhite : TSysCharSet;
- const strValue : string;
- var strResult : TStringList;
- unknownFlag : boolean = false
- );
+ const chrSep : TSysCharSet;
+ const chrWhite : TSysCharSet;
+ const strValue : string;
+ var strResult : TStringList;
+ unknownFlag : boolean = false
+);
var
- last, p, strLen : Integer;
+ last, p, strLen : Integer;
begin
- strLen := Length( strValue );
- p := 1;
- last := 1;
+ strLen := Length( strValue );
+ p := 1;
+ last := 1;
- while p <= strLen do
- begin
+ while p <= strLen do
+ begin
- if strValue[ p ] in chrSep then
- begin
- strResult.Add( Copy( strValue, last, p - last ) );
- last := p + 1;
- end;
+ if strValue[ p ] in chrSep then
+ begin
+ strResult.Add( Copy( strValue, last, p - last ) );
+ last := p + 1;
+ end;
- p := p + 1;
+ p := p + 1;
- end;
+ end;
- if last <> p then
- strResult.Add( Copy( strValue, last, strLen - last + 1 ) );
+ if last <> p then
+ strResult.Add( Copy( strValue, last, strLen - last + 1 ) );
end;
function HtmlEncode(
- const strValue : string
- ) : string;
+ const strValue : string
+) : string;
var
- i : Integer;
- strLen : Integer;
- strResult : string;
+ i : Integer;
+ strLen : Integer;
+ strResult : string;
begin
- strLen := Length( strValue );
- i := 1;
-
- while i <= strLen do
- begin
-
- case strValue[ i ] of
- '&':
- begin
- strResult := strResult + '&';
- end;
- '<':
- begin
- strResult := strResult + '<';
- end;
- '>':
- begin
- strResult := strResult + '>';
- end;
- '"':
- begin
- strResult := strResult + '"';
- end;
- else
- begin
- if strValue[ i ] in kXMLKanji then
- begin
- strResult := strResult + strValue[ i ];
- Inc( i );
- end;
- strResult := strResult + strValue[ i ];
- end;
- end;
-
- i := i + 1;
-
- end;
-
- Result := strResult;
+ strLen := Length( strValue );
+ i := 1;
+
+ while i <= strLen do
+ begin
+
+ case strValue[ i ] of
+ '&':
+ begin
+ strResult := strResult + '&';
+ end;
+ '<':
+ begin
+ strResult := strResult + '<';
+ end;
+ '>':
+ begin
+ strResult := strResult + '>';
+ end;
+ '"':
+ begin
+ strResult := strResult + '"';
+ end;
+ else
+ begin
+ if strValue[ i ] in kYofKanji then
+ begin
+ strResult := strResult + strValue[ i ];
+ Inc( i );
+ end;
+ strResult := strResult + strValue[ i ];
+ end;
+ end;
+
+ i := i + 1;
+
+ end;
+
+ Result := strResult;
end;
function HtmlDecode(
- const strValue : string
- ) : string;
+ const strValue : string
+) : string;
var
- strResult : string;
+ strResult : string;
begin
- strResult := StringReplace( strValue, '<', '<', [rfReplaceAll] );
- strResult := StringReplace( strResult, '>', '>', [rfReplaceAll] );
- strResult := StringReplace( strResult, '"', '"', [rfReplaceAll] );
- strResult := StringReplace( strResult, '&', '&', [rfReplaceAll] );
+ strResult := StringReplace( strValue, '<', '<', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '>', '>', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '"', '"', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '&', '&', [rfReplaceAll] );
- Result := strResult;
+ Result := strResult;
end;
function HttpEncode(
- const strValue : string
- ) : string;
+ const strValue : string
+ ) : string;
var
- i : Integer;
- strLen : Integer;
- strResult : string;
- b : Integer;
+ i : Integer;
+ strLen : Integer;
+ strResult : string;
+ b : Integer;
const
- kHexCode : array [0..15] of char = (
- '0', '1', '2', '3', '4', '5', '6', '7',
- '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
+ kHexCode : array [0..15] of char = (
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
begin
- strLen := Length( strValue );
- i := 1;
-
- while i <= strLen do
- begin
+ strLen := Length( strValue );
+ i := 1;
- case strValue[ i ] of
- '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_':
- begin
- strResult := strResult + strValue[ i ];
- end;
- else
- begin
- b := Integer( strValue[ i ] );
- strResult := strResult + '%'
- + kHexCode[ b div $10 ]
- + kHexCode[ b mod $10 ];
- end;
- end;
+ while i <= strLen do
+ begin
- i := i + 1;
-
- end;
-
- Result := strResult;
-
-end;
-
-// \82Æ\82è\82 \82¦\82¸\82Ì\91ã\97p\95i\82È\82Ì\82Å [] \82ð\8eg\82Á\82½\90³\8bK\95\\8c»\82ð\8dl\97¶\82µ\82Ä\82¢\82È\82¢\82±\82Æ\82É\92\8d\88Ó\81I\81I\81I
-function MatchesMask(
- const filename, mask : string
- ) : boolean;
-var
- pName, pMask : Integer;
- nameLen, maskLen : Integer;
- chrUpMask : char;
-begin
+ case strValue[ i ] of
+ '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_':
+ begin
+ strResult := strResult + strValue[ i ];
+ end;
+ else
+ begin
+ b := Integer( strValue[ i ] );
+ strResult := strResult + '%'
+ + kHexCode[ b div $10 ]
+ + kHexCode[ b mod $10 ];
+ end;
+ end;
- nameLen := Length( filename );
- maskLen := Length( mask );
- pName := 0;
- pMask := 0;
-
- while (pMask < maskLen) and (pName < nameLen) do
- begin
-
- case mask[ pMask ] of
- '?':
- begin
- // \82±\82Ì 1 \8e\9a\82Í\89½\82à\82µ\82È\82¢
- end;
- '*':
- begin
- pMask := pMask + 1;
- // mask \82ð\91\96\8d¸\82µ\90Ø\82Á\82½\82ç\8fI\97¹
- if pMask >= maskLen then
- begin
- Result := true;
- exit;
- end;
-
- // * \82Ì\8e\9f\82Ì\95¶\8e\9a\82ª\97\88\82é\82Ü\82Å\94ò\82Î\82·
- chrUpMask := upcase( mask[ pMask ] );
- while chrUpMask <> UpCase( filename[ pName ] ) do
- begin
- pName := pName + 1;
- if pName >= nameLen then
- begin
- Result := true;
- exit;
- end;
- end;
-
- // * \82Ì\8e\9f\82Ì\95¶\8e\9a\82ª\8c©\82Â\82©\82ç\82È\82©\82Á\82½\82ç\8fI\97¹
- if chrUpMask <> UpCase( filename[ pName ] ) then
- begin
- Result := false;
- exit;
- end;
-
- pName := pName + 1;
- pMask := pMask + 1;
- end;
- else
- begin
- // \82±\82Ì 1 \95¶\8e\9a\82ª\88á\82Á\82½\82ç\8fI\97¹
- if UpCase( mask[ pMask ] ) <> UpCase( filename[ pName ] ) then
- begin
- Result := false;
- exit;
- end;
-
- end;
- end;
-
- // \8e\9f\82Ì\95¶\8e\9a\82Ö
- pName := pName + 1;
- pMask := pMask + 1;
-
- end;
-
- if (pMask >= maskLen) and (pName >= nameLen) then
- Result := true
- else
- Result := false;
+ i := i + 1;
-end;
+ end;
-// untilSet \82É\82È\82é\82Ü\82Å\94ò\82Î\82·
-procedure FileThruUntil(
- var f : TFileStream;
- const untilSet : TSysCharSet
-);
-var
- ch : char;
-begin
- while f.Position < f.Size do
- begin
- f.ReadBuffer( ch, 1 );
- if ch in untilSet then
- begin
- f.Seek( -1, soFromCurrent );
- exit;
- end else if ch in kXMLKanji then
- f.Seek( 1, soFromCurrent );
- end;
-end;
+ Result := strResult;
-// whileSet \82Ì\8aÔ\94ò\82Î\82·
-procedure FileThruWhile(
- var f : TFileStream;
- const whileSet : TSysCharSet
-);
-var
- ch : char;
-begin
- while f.Position < f.Size do
- begin
- f.ReadBuffer( ch, 1 );
- if ch in whileSet then
- begin
- if ch in kXMLKanji then
- f.ReadBuffer( ch, 1 );
- end else begin
- f.Seek( -1, soFromCurrent );
- exit;
- end;
- end;
end;
-function XMLCloseCheck(
- var f : TFileStream;
- var node : IXMLNode;
- ch : char;
- out tag : string;
- out closed : boolean
-) : boolean; // ch \82ð\82±\82Ì\83\8b\81[\83`\83\93\82ª\8f\88\97\9d\82µ\82½\82È\82ç true
-var
- last : Integer;
- tagLen : Integer;
-begin
- closed := false;
- Result := false;
- tag := '';
-
- if ch = '>' then
- begin
- // \8aJ\8en\83^\83O\82Ì\8dÅ\8cã\82Ü\82Å\93Ç\82ñ\82¾
- Result := true;
- end else if ch = '?' then
- begin
- // <?xml?> \82Ý\82½\82¢\82È\82â\82Â\81B\82æ\82Á\82Ä\96³\8e\8b
- FileThruUntil( f, kXMLTagEnd );
- FileThruUntil( f, kXMLTagStart );
- f.Seek( 1, soFromCurrent );
- FileThruWhile( f, kXMLWhite );
- //closed := true;
- Result := true;
- end else if ch = '/' then
- begin
- // \83^\83O\96¼\82ð\93Ç\82Ý\8d\9e\82ñ\82Å\95Ô\82·
- last := f.Position;
- FileThruUntil( f, kXMLTagEnd );
- tagLen := f.Position - last;
- SetLength( tag, tagLen );
-
- f.Seek( last, soFromBeginning );
- f.ReadBuffer( PChar( tag )^, tagLen );
-
- f.Seek( f.Position + 1, soFromBeginning ); // '>' \94ò\82Î\82µ
- closed := true;
- Result := true;
- end;
+function toupper(
+ ch : Longword
+) : Byte; Register;
+asm
+ mov ecx, eax // ecx = (ch - 'a')
+ sub cl, 'a'
+ cmp ecx, 26 // edx = ecx < 26 (\8f¬\95¶\8e\9a\82È\82ç\83t\83\8b\83r\83b\83g)
+ sbb edx, edx
+ and edx, $20 // edx &= 0x20 (\8f¬\95¶\8e\9a\82È\82ç 0x20)
+ xor eax, edx // eax ^= edx
end;
-function XMLReadNode(
- var f : TFileStream;
- var node : IXMLNode
-) : string; // node \88È\8aO\82Ì\83m\81[\83h\82ª\95Â\82¶\82ç\82ê\82½\8fê\8d\87\82Ì\83m\81[\83h\96¼
+function HttpDecode(
+ const strValue : string
+) : string;
var
- child : IXMLNode;
-
- last : Integer;
- tag : string;
- tagLen : Integer;
-
- isClosed : boolean;
-
- attributeName : string;
- attributeValue : string;
-
- ch : char;
-label
- NextNode;
+ i : Integer;
+ strLen : Integer;
+ strResult : string;
+ b : Integer;
begin
- try
- // node \82Ì\93Ç\82Ý\8d\9e\82Ý(1 \83\8b\81[\83v\82É\82Â\82« 1 \83m\81[\83h)
- node.ChildNodes := IXMLNode.Create;
-
- while f.Position < f.Size do
- begin
- // NodeName \93Ç\82Ý\8d\9e\82Ý
- FileThruWhile( f, kXMLWhite );
-
- while f.Position < f.Size do
- begin
- f.ReadBuffer( ch, 1 );
-
- if XMLCloseCheck( f, node, ch, tag, isClosed ) then
- begin
- if isClosed then
- begin
- Result := tag;
- exit;
- end;
-
- goto NextNode;
- end else if ch = '<' then
- begin
- // \90V\8bK\83m\81[\83h
- child := IXMLNode.Create;
- tag := XMLReadNode( f, child );
- node.ChildNodes.Add( child );
-
- // \83^\83O\82ª\95Â\82¶\82ç\82ê\82½
- if Length( tag ) > 0 then
- begin
- // \8e©\95ª\82Ì\82à\82Ì\82©\83`\83F\83b\83N\82µ\82Ä\81A\88á\82¦\82Î\90e\82É\95Ô\82·
- if tag <> node.NodeName then
- Result := tag;
- exit;
- end;
-
- goto NextNode;
- end else if ch in kXMLWhite then
- begin
- // NodeName \8a®\97¹
- break;
- end else begin
- node.NodeName := node.NodeName + ch;
-
- if ch in kXMLKanji then
- begin
- f.ReadBuffer( ch, 1 );
- node.NodeName := node.NodeName + ch;
- end;
- end;
- end;
-
- // Attribute \82Ì\93Ç\82Ý\8d\9e\82Ý
- while f.Position < f.Size do
- begin
- // Attribute \82Ì\96¼\91O\82ð\93Ç\82Ý\8d\9e\82Ý
- attributeName := '';
- attributeValue := '';
-
- FileThruWhile( f, kXMLWhite );
-
- while f.Position < f.Size do
- begin
- f.ReadBuffer( ch, 1 );
-
- if XMLCloseCheck( f, node, ch, tag, isClosed ) then
- begin
- if isClosed then
- begin
- // \83^\83O\82ª\95Â\82¶\82ç\82ê\82½\82Ì\82Å\83\8a\83^\81[\83\93
- // \81¦NodeName \82ð\92Ê\89ß\82µ\82Ä\82é\82Ì\82Å\93r\92\86\82Å\95Â\82¶\82Ä\82é\82±\82Æ\82É\82È\82é\81B
- // \82æ\82Á\82Ä\93Æ\97§\83m\81[\83h\81B
- exit;
- end;
-
- // \8e\9f\82Ì\83m\81[\83h\82Ö
- goto NextNode;
- end else if ch = '=' then
- begin
- // \82±\82±\82©\82ç\82Í\92l\82ª\8en\82Ü\82é\82Ì\82Å\96¼\91O\82Í\8fI\97¹
- break;
- end else if ch in kXMLWhite then
- begin
- // Value \82ª\91¶\8dÝ\82µ\82È\82¢(\8bK\8ai\8aO)\82Ì\82Å\8e\9f\82Ì\83m\81[\83h\82Ö
- goto NextNode;
- end else begin
- attributeName := attributeName + ch;
-
- if ch in kXMLKanji then
- begin
- f.ReadBuffer( ch, 1 );
- attributeName := attributeName + ch;
- end;
- end;
-
- end;
-
- // Attribute \82Ì\92l\82ð\93Ç\82Ý\8d\9e\82Ý
- FileThruWhile( f, kXMLWhite );
-
- while f.Position < f.Size do
- begin
- f.ReadBuffer( ch, 1 );
-
- if XMLCloseCheck( f, node, ch, tag, isClosed ) then
- begin
- if isClosed then
- begin
- if Length( attributeName ) > 0 then
- // \8bK\8ai\8aO\82¾\82¯\82Ç\82Ë
- node.AddAttribute( attributeName, attributeValue );
-
- // \83^\83O\82ª\95Â\82¶\82ç\82ê\82½\82Ì\82Å\83\8a\83^\81[\83\93
- // \81¦NodeName \82ð\92Ê\89ß\82µ\82Ä\82é\82Ì\82Å\93r\92\86\82Å\95Â\82¶\82Ä\82é\82±\82Æ\82É\82È\82é\81B
- // \82æ\82Á\82Ä\93Æ\97§\83m\81[\83h\81B
- exit;
- end;
-
- // \8e\9f\82Ì\83m\81[\83h\82Ö
- goto NextNode;
- end else if ch = '"' then
- begin
- // \92l\82ª "" \82Å\8a\87\82ç\82ê\82Ä\82é\82Ì\82Å(\82Ä\82¢\82¤\82©\8a\87\82ç\82ê\82Ä\82È\82«\82á\82¢\82¯\82È\82¢\82ñ\82¾\82¯\82Ç)
- // \92l\82ð\88ê\8a\87\93Ç\82Ý\8d\9e\82Ý
- last := f.Position;
- FileThruUntil( f, kXMLDQuote );
- tagLen := f.Position - last;
- SetLength( attributeValue, tagLen );
-
- f.Seek( last, soFromBeginning );
- f.ReadBuffer( PChar( attributeValue )^, tagLen );
-
- node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
-
- // \92l\82ð\93Ç\82Ý\8fI\82í\82Á\82½\82Ì\82Å\8fI\97¹
- f.Seek( f.Position + 1, soFromBeginning ); // '"' \94ò\82Î\82µ
- break;
- end else if ch in kXMLWhite then
- begin
- // \8bK\8ai\8aO\82¾\82¯\82Ç\82Ë
- node.AddAttribute( attributeName, HtmlDecode( attributeValue ) );
-
- goto NextNode;
- end else begin
- // \8bK\8ai\8aO\82¾\82¯\82Ç\88ê\89\9e\8eæ\82Á\82Ä\82¨\82
- attributeValue := attributeValue + ch;
-
- if ch in kXMLKanji then
- begin
- f.ReadBuffer( ch, 1 );
- attributeValue := attributeValue + ch;
- end;
- end;
- end;
- end; // Attribute \82Ì\93Ç\82Ý\8d\9e\82Ý
-
- NextNode:;
- end; // // node \82Ì\93Ç\82Ý\8d\9e\82Ý(1 \83\8b\81[\83v\82É\82Â\82« 1 \83m\81[\83h)
- finally
- end;
-end;
-function LoadXMLDocument(
- const fileName : string
- ) : IXMLDocument;
-type
- xmlMode = ( xmlHoge );
-var
- xmlFile : TFileStream;
- doc : IXMLDocument;
-begin
+ strLen := Length( strValue );
+ i := 1;
- doc := IXMLDocument.Create;
+ while i <= strLen do
+ begin
- xmlFile := TFileStream.Create( fileName, fmOpenRead );
- XMLReadNode( xmlFile, IXMLNode( doc ) );
- xmlFile.Destroy;
+ if '%' = strValue[ i ] then begin
+ Inc( i );
+ if strValue[ i ] in ['a' .. 'z', 'A' .. 'Z'] then
+ b := (toupper( Longword( strValue[ i ] ) ) - 55) shl 4
+ else
+ b := (Byte( strValue[ i ] ) - Byte( '0' )) shl 4;
+ Inc( i );
+ if strValue[ i ] in ['a' .. 'z', 'A' .. 'Z'] then
+ b := b or (toupper( Longword( strValue[ i ] ) ) - 55)
+ else
+ b := b or (Byte( strValue[ i ] ) - Byte( '0' ));
- Result := doc;
+ strResult := strResult + Char( Byte( b ) );
+ end else begin
+ strResult := strResult + strValue[ i ];
+ end;
-end;
+ Inc( i );
-procedure memcpy(
- dst : PChar;
- src : PChar;
- size : Integer
-);
-begin
- while size > 0 do
- begin
- dst^ := src^;
- Inc( dst );
- Inc( src );
- Dec( size );
- end;
-end;
+ end;
-procedure transpose(
- var data : CryptBlock;
- var t : CryptOrdering;
- n : Integer
-);
-var
- x : CryptBlock;
-begin
- x := data;
+ Result := strResult;
- while n > 0 do
- begin
- Dec( n );
- data.b_data[ n ] := x.b_data[ Integer( t.o_data[ n ] ) - 1 ];
- end;
end;
-procedure rotate(
- var key : CryptBlock
-);
+// \82Æ\82è\82 \82¦\82¸\82Ì\91ã\97p\95i\82È\82Ì\82Å [] \82ð\8eg\82Á\82½\90³\8bK\95\\8c»\82ð\8dl\97¶\82µ\82Ä\82¢\82È\82¢\82±\82Æ\82É\92\8d\88Ó\81I\81I\81I
+function MatchesMask(
+ const filename, mask : string
+ ) : boolean;
var
- p : PChar;
- ep : PChar;
- data0, data28 : Char;
+ pName, pMask : Integer;
+ ptrName, ptrMask : PChar;
+ nameLen, maskLen : Integer;
+ chrUpMask : char;
+ delimiterPos : Integer;
begin
- p := key.b_data;
- ep := @(key.b_data[ 55 ]);
- data0 := key.b_data[ 0 ];
- data28 := key.b_data[ 28 ];
-
- while p < ep do
- begin
- Inc( p );
- p[ -1 ] := p^;
- end;
- key.b_data[ 27 ] := data0;
- key.b_data[ 55 ] := data28;
-end;
-procedure f(
- i : Integer;
- var key : CryptBlock;
- var a : CryptBlock;
- var x : CryptBlock;
- var data : CryptData
-);
-var
- e, ikey, y : CryptBlock;
- k : Integer;
- p, q, r : PChar;
+ nameLen := Length( filename );
+ maskLen := Length( mask );
+ ptrName := PChar( filename );
+ ptrMask := PChar( mask );
+ pName := 0;
+ pMask := 0;
+ delimiterPos := Pos( '\', string( ptrName + pName ) );
+ while delimiterPos > 0 do
+ begin
+ pName := pName + delimiterPos;
+ delimiterPos := Pos( '\', string( ptrName + pName ) );
+ end;
- xb, ir : Integer;
+ while (pMask < maskLen) and (pName < nameLen) do
+ begin
+
+ case ptrMask[ pMask ] of
+ '?':
+ begin
+ // \82±\82Ì 1 \8e\9a\82Í\89½\82à\82µ\82È\82¢
+ end;
+ '*':
+ begin
+ pMask := pMask + 1;
+ // mask \82ð\91\96\8d¸\82µ\90Ø\82Á\82½\82ç\8fI\97¹
+ if pMask >= maskLen then
+ begin
+ Result := true;
+ exit;
+ end;
+
+ // * \82Ì\8e\9f\82Ì\95¶\8e\9a\82ª\97\88\82é\82Ü\82Å\94ò\82Î\82·
+ chrUpMask := upcase( ptrMask[ pMask ] );
+ while chrUpMask <> UpCase( ptrName[ pName ] ) do
+ begin
+ pName := pName + 1;
+ if pName >= nameLen then
+ begin
+ Result := true;
+ exit;
+ end;
+ end;
+
+ // * \82Ì\8e\9f\82Ì\95¶\8e\9a\82ª\8c©\82Â\82©\82ç\82È\82©\82Á\82½\82ç\8fI\97¹
+ if chrUpMask <> UpCase( ptrName[ pName ] ) then
+ begin
+ Result := false;
+ exit;
+ end;
+
+ pName := pName + 1;
+ pMask := pMask + 1;
+ end;
+ else
+ begin
+ // \82±\82Ì 1 \95¶\8e\9a\82ª\88á\82Á\82½\82ç\8fI\97¹
+ if UpCase( ptrMask[ pMask ] ) <> UpCase( ptrName[ pName ] ) then
+ begin
+ Result := false;
+ exit;
+ end;
+
+ end;
+ end;
+
+ // \8e\9f\82Ì\95¶\8e\9a\82Ö
+ pName := pName + 1;
+ pMask := pMask + 1;
- temp : CryptOrdering;
-begin
- e := a;
- transpose( e, data.EP^, 48 );
- for k := kCryptRots[ i ] downto 1
- do rotate( key );
- ikey := key;
- temp := kCryptKeyTr2; transpose( ikey, temp, 48 );
- p := @(y.b_data[ 48 ]);
- q := @(e.b_data[ 48 ]);
- r := @(ikey.b_data[ 48 ]);
- while p > y.b_data do
- begin
- Dec( p );
- Dec( q );
- Dec( r );
- p^ := Char( Integer( q^ ) xor Integer( r^ ) );
- end;
- q := x.b_data;
- for k := 0 to 7 do
- begin
- ir := Integer( p^ ) shl 5; Inc( p );
- ir := ir + Integer( p^ ) shl 3; Inc( p );
- ir := ir + Integer( p^ ) shl 2; Inc( p );
- ir := ir + Integer( p^ ) shl 1; Inc( p );
- ir := ir + Integer( p^ ); Inc( p );
- ir := ir + Integer( p^ ) shl 4; Inc( p );
-
- xb := Integer( kCryptS_Boxes[ k, ir ] );
-
- q^ := Char( (xb shr 3) and 1 ); Inc( q );
- q^ := Char( (xb shr 2) and 1 ); Inc( q );
- q^ := Char( (xb shr 1) and 1 ); Inc( q );
- q^ := Char( xb and 1 ); Inc( q );
- end;
- temp := kCryptPtr; transpose( x, temp, 32 );
-end;
+ end;
-procedure setkey_r(
- k : PChar;
- var data : CryptData
-);
-var
- //key : CryptBlock;
+ if (pMask >= maskLen) and (pName >= nameLen) then
+ Result := true
+ else
+ Result := false;
- temp : CryptOrdering;
-begin
- memcpy( data.Key.b_data, k, sizeof(CryptBlock) );
- temp := kCryptKeyTr1; transpose( data.Key, temp, 56 );
end;
-procedure encrypt_r(
- blck : PChar;
- edflag : Integer;
- var data : CryptData
-);
-var
- key : PCryptBlock;
- p : PCryptBlock;
- i : Integer;
-
- j : Integer;
- k : Integer;
- b, x : CryptBlock;
-
- temp : CryptOrdering;
-begin
- key := @data.Key;
- p := PCryptBlock( blck );
-
- temp := kCryptInitialTr;transpose( p^, temp, 64 );
- for i := 15 downto 0 do
- begin
- if edflag <> 0 then
- j := i
- else
- j := 15 - i;
-
- b := p^;
- for k := 31 downto 0
- do p^.b_data[ k ] := b.b_data[ k + 32 ];
- f( j, key^, p^, x, data );
- for k := 31 downto 0
- do p^.b_data[ k + 32 ] := Char( Integer( b.b_data[ k ] ) xor Integer( x.b_data[ k ] ) );
- end;
- temp := kCryptSwap; transpose( p^, temp, 64 );
- temp := kCryptFinalTr; transpose( p^, temp, 64 );
-end;
-function crypt_r(
- pw : PChar;
- salt : PChar;
- var data : CryptData
+// \83\81\83^\83L\83\83\83\89\83N\83^\82ð\90³\8bK\95\\8c»\88µ\82¢\82É\82È\82ç\82È\82¢\82æ\82¤\82É\92u\8a·
+function RegExpEncode(
+ const text : string
) : string;
var
- pwb : array [0..65] of char;
- cp : PChar;
- ret : array [0..15] of char;
- p : PChar;
- new_etr : CryptOrdering;
- i : Integer;
-
- j : Integer;
- c : Char;
- t : Integer;
- temp : Integer;
+ strResult : string;
begin
- p := pwb;
- data.EP := @kCryptEtr;
- while (pw^ <> #0) and (p < pwb + 64) do
- begin
- j := 7;
-
- while j > 0 do
- begin
- Dec( j );
- p^ := Char( (Integer(pw^) shr j) and 1 );
- Inc( p );
- end;
- //Dec( j );
-
- Inc( pw );
- p^ := #0;
- Inc( p );
- end;
- while (p < pwb + 64) do
- begin
- p^ := #0;
- Inc( p );
- end;
-
- p := pwb;
- setKey_r( p, data );
-
- while (p < pwb + 66) do
- begin
- p^ := #0;
- Inc( p );
- end;
-
- new_etr := kCryptEtr;
- data.EP := @new_etr;
- if (salt[ 0 ] = #0) and (salt[ 1 ] = #0) then
- salt := '**#0';
- for i := 0 to 1 do
- begin
- c := salt^;
- Inc( salt );
-
- ret[ i ] := c;
- if c > 'Z' then
- c := Char( Integer(c) - (6 + 7 + Integer('.')) )
- else if c > '9' then
- c := Char( Integer(c) - (7 + Integer('.')) )
- else
- c := Char( (Integer(c) - Integer('.')) and $ff );
-
- for j := 0 to 5 do
- begin
- if ((Integer(c) shr j) and 1) <> 0 then
- begin
- t := 6 * i + j;
- temp := Integer( new_etr.o_data[ t ] );
- new_etr.o_data[ t ] := new_etr.o_data[ t + 24 ];
- new_etr.o_data[ t + 24 ] := Char( temp );
- end;
- end;
- end;
-
- if ret[ 1 ] = #0 then
- ret[ 1 ] := ret[ 0 ];
-
- for i := 0 to 24 do
- encrypt_r( pwb, 0, data );
- data.EP := @kCryptEtr;
-
- p := pwb;
- cp := ret + 2;
- while p < pwb + 66 do
- begin
- c := #0;
- j := 6;
-
- while j > 0 do
- begin
- Dec( j );
- c := Char( (Integer(c) shl 1) or Integer(p^) );
- Inc( p );
- end;
- //Dec( j );
- c := Char( Integer(c) + Integer('.') );
- if c > '9' then
- c := Char( Integer(c) + 7 );
- if c > 'Z' then
- c := Char( Integer(c) + 6 );
- cp^ := c;
- Inc( cp );
- end;
- cp^ := #0;
- Result := ret;
+ strResult := StringReplace( text, '\', '\\', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '[', '\[', [rfReplaceAll] );
+ strResult := StringReplace( strResult, ']', '\]', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '(', '\(', [rfReplaceAll] );
+ strResult := StringReplace( strResult, ')', '\)', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '[', '\[', [rfReplaceAll] );
+ strResult := StringReplace( strResult, ']', '\]', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '*', '\*', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '?', '\?', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '.', '\.', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '+', '\+', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '|', '\|', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '^', '\^', [rfReplaceAll] );
+ strResult := StringReplace( strResult, '$', '\$', [rfReplaceAll] );
+
+ Result := strResult;
end;
-function get_2ch_trip(
- const pw : PChar
-) : string;
-var
- s : CryptData;
- salt : array [0..2] of char;
-
- i : Integer;
- len : Integer;
-begin
- salt[ 0 ] := #0;
- if pw[ 0 ] = #0 then
- begin
- Result := '';
- Exit;
- end;
-
- if pw[ 1 ] <> #0 then
- begin
- if pw[ 2 ] <> #0 then
- len := 2
- else
- len := 1;
- for i := 0 to len - 1 do
- begin
- if ('.' <= pw[ i + 1 ]) and (pw[ i + 1 ] <= 'z' ) then
- salt[ i ] := pw[ i + 1 ]
- else
- salt[ i ] := '.';
-
- if Pos( salt[ i ], ':;<=>?@[\\]^_`' ) > 0 then
- salt[ i ] := Char( Integer( salt[ i ] ) + 7 );
- end;
- if len = 1 then
- salt[ 1 ] := 'H';
- salt[ 2 ] := #0;
- end else begin
- salt[ 0 ] := 'H';
- salt[ 1 ] := '.';
- end;
-
- Result := Copy( crypt_r( pw, salt, s ), 4, 100 );
-end;
-
end.
OSDN Git Service
