WebSVN – fastphp – Diff – /trunk/Functions.pas


unit Functions;
 
interface
 
uses
  Windows, Messages, SysUtils, StrUtils, IniFiles, Classes, Forms, Variants, MsHTML,
  StdCtrls, SynEdit, ActiveX;
 
type
  TContentCallBack = procedure(Content: string) of object;
 
function GetDosOutput(CommandLine: string; Work: string = ''; ContentCallBack: TContentCallBack=nil): String;
function StrIPos(const SubStr, S: string): Integer;
function LoadFileToStr(const FileName: TFileName): AnsiString;
function LastPos(const SubStr, S: string): integer;
function IsTextHTML(s: string): boolean;
function GetWordUnderPos(AMemo: TSynEdit; Line, Column: integer): string;
function GetWordUnderCaret(AMemo: TSynEdit): string;
function MyVarToStr(v: Variant): string;
function FileSystemCaseSensitive: boolean;
function HighColorWindows: boolean;
function GetTempDir: string;
function GetSpecialFolder(const aCSIDL: Integer): string;
function GetMyDocumentsFolder: string;
function MD5(const str: string): string;
function MD5Stream(const s: TStream): string;
 
implementation
 
uses
  ShlObj, // Needed for the CSIDL constants
  IdGlobal, IdHash, IdHashMessageDigest; // used for MD5 calculation
 
function GetDosOutput(CommandLine: string; Work: string = ''; ContentCallBack: TContentCallBack=nil): String;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  if Work = '' then Work := ExtractFilePath(ParamStr(0));
 
  Result := '';
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := Work;
    Handle := CreateProcess(nil, PChar('cmd.exe /C "' + CommandLine + '"'),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            Result := Result + string(Buffer);
            if Assigned(ContentCallBack) then ContentCallBack(string(Buffer));
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;
 
function StrIPos(const SubStr, S: string): Integer;
begin
  Result := Pos(UpperCase(SubStr), UpperCase(S));
end;
 
function LoadFileToStr(const FileName: TFileName): AnsiString;
var
  FileStream : TFileStream;
 
begin
  Result := '';
  FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    if FileStream.Size>0 then begin
      SetLength(Result, FileStream.Size);
      FileStream.Read(Result[1], FileStream.Size);
    end;
  finally
    FileStream.Free;
  end;
end;
 
function LastPos(const SubStr, S: string): integer;
var
  I, J, K: integer;
begin
  Result := 0;
  I := Length(S);
  K := Length(SubStr);
  if (K = 0) or (K > I) then
    Exit;
  while (Result = 0) and (I >= K) do
  begin
    J := K;
    if S[I] = SubStr[J] then
    begin
      while (J > 1) and (S[I + J - K - 1] = SubStr[J - 1]) do
        Dec(J);
      if J = 1 then
        Result := I - K + 1;
    end;
    Dec(I);
  end;
end;
 
function IsTextHTML(s: string): boolean;
 
  function _Tag(const tag: string): integer;
  begin
    result := 0;
    if (StrIPos('<'+tag+'>', s) > 0) then Inc(result);
    if (StrIPos('</'+tag+'>', s) > 0) then Inc(result);
    if (StrIPos('<'+tag+' />', s) > 0) then Inc(result);
    if (StrIPos('<'+tag+' ', s) > 0) then Inc(result);
  end;
 
  procedure _Check(const tag: string; pair: boolean);
  begin
    if (pair and (_Tag(tag) >= 2)) or (not pair and (_Tag(tag) >= 1)) then result := true;
  end;
 
begin
  result := false;
  _Check('html', true);
  _Check('body', true);
  _Check('p', false{end tag optional});
  _Check('a', true);
  _Check('b', true);
  _Check('i', true);
  _Check('u', true);
  _Check('li', false{end tag optional});
  _Check('ol', true);
  _Check('ul', true);
  _Check('img', false);
  _Check('div', false);
  _Check('hr', false);
  _Check('code', true);
  _Check('pre', true);
  _Check('blockquote', true);
  _Check('span', true);
  _Check('br', false);
end;
 
// Template: http://stackoverflow.com/questions/6339446/delphi-get-the-whole-word-where-the-caret-is-in-a-memo
function GetWordUnderPos(AMemo: TSynEdit; Line, Column: integer): string;
 
  function ValidChar(c: char): boolean;
  begin
    {$IFDEF UNICODE}
    result := CharInSet(c, ['a'..'z', 'A'..'Z', '0'..'9', '_']);
    {$ELSE}
    result := c in ['a'..'z', 'A'..'Z', '0'..'9', '_'];
    {$ENDIF}
  end;
 
var
   LineText: string;
   InitPos : Integer;
   EndPos  : Integer;
begin
   //Validate the line number
   if AMemo.Lines.Count-1 < Line then Exit;
 
   //Get the text of the line
   LineText := AMemo.Lines[Line];
 
   if LineText = '' then
   begin
     result := '';
     exit;
   end;
 
   // Column zeigt auf das Zeichen LINKS vom Cursor!
 
   InitPos := Column;
   if not ValidChar(LineText[InitPos]) then Inc(InitPos);
   while (InitPos-1 >= 1) and ValidChar(LineText[InitPos-1]) do Dec(InitPos);
 
   EndPos := Column;
   while (EndPos+1 <= Length(LineText)) and ValidChar(LineText[EndPos+1]) do Inc(EndPos);
 
   //Get the text
   Result := Copy(LineText, InitPos, EndPos - InitPos + 1);
end;
 
function GetWordUnderCaret(AMemo: TSynEdit): string;
var
   Line    : Integer;
   Column  : Integer;
begin
   //Get the caret position
   (*
   if AMemo is TMemo then
   begin
     Line   := AMemo.Perform(EM_LINEFROMCHAR,AMemo.SelStart, 0);
     Column := AMemo.SelStart - AMemo.Perform(EM_LINEINDEX, Line, 0);
   end;
   if AMemo is TSynEdit then
   begin
   *)
     Line := AMemo.CaretY-1;
     Column := AMemo.CaretX-1;
   (*
   end;
   *)
 
   result := GetWordUnderPos(AMemo, Line, Column);
end;
 
function MyVarToStr(v: Variant): string;
var
  _Lo, _Hi, i: integer;
begin
  if VarIsNull(v) then
  begin
    result := '';
  end
  else if VarIsArray(v) then
  begin
    _Lo := VarArrayLowBound(v, 1);
    _Hi := VarArrayHighBound(v, 1);
    result := '';
    for i := _Lo to _Hi do
    begin
      if v[i] = 0 then break;
      result := result + chr(integer(v[i]));
    end;
  end
  else
  begin
    // At least try it...
    result := VarToStr(v);
  end;
end;
 
function FileSystemCaseSensitive: boolean;
begin
  // TODO: This code is not very reliable. At MAC OSX, the file system HFS can be switched
  //       between case sensitivity and insensitivity.
  {$IFDEF LINUX}
  exit(true);
  {$ELSE}
  result := false;
  exit;
  {$ENDIF}
end;
 
function HighColorWindows: boolean;
var
  ver: Cardinal;
  dwMajorVersion, dwMinorVersion: integer;
begin
  ver := GetVersion();
  dwMajorVersion := Lo(ver);
  dwMinorVersion := Hi(ver);
 
  // Gradient fitting in:
  // 5.1 = XP
  // 5.2 = Windows Server 2003
  // 6.0 = Vista
  // 6.1 = Win7
 
  result := ((dwMajorVersion = 5) and (dwMinorVersion >= 1)) or
            ((dwMajorVersion = 6) and (dwMinorVersion <= 1));
end;
 
function GetTempDir: string;
var
  Dir: string;
  Len: DWord;
begin
  SetLength(Dir,MAX_PATH);
  Len:=GetTempPath(MAX_PATH, PChar(Dir));
  if Len>0 then
  begin
    SetLength(Dir,Len);
    Result:=Dir;
  end
  else
    RaiseLastOSError;
end;
 
function SHGetFolderPath(hwnd: HWND; csidl: Integer; hToken: THandle;
  dwFlags: DWord; pszPath: LPWSTR): HRESULT; stdcall;
  external 'SHFolder.dll' name 'SHGetFolderPathW';
 
function GetSpecialFolder(const aCSIDL: Integer): string;
var
  FolderPath: array[0 .. MAX_PATH] of Char;
begin
  SetLastError(ERROR_SUCCESS);
  if SHGetFolderPath(0, aCSIDL, 0, 0, @FolderPath) = S_OK then
    Result := FolderPath;
end;
 
function GetMyDocumentsFolder: string;
begin
  Result := GetSpecialFolder(CSIDL_PERSONAL);
end;
 
 
{$IF gsIdVersion <> '10.1.5'} // Delphi 2007 built-in Indy10; gsIdVersion requires idGlobal.pas
{$DEFINE NewIndy}
{$IFEND}
 
function MD5Stream(const s: TStream): string;
var
  idmd5: TIdHashMessageDigest5;
begin
  idmd5 := TIdHashMessageDigest5.Create;
  try
    {$IFDEF NewIndy}
    result := idmd5.HashStreamAsHex(s);
    {$ELSE}
    result := idmd5.AsHex(idmd5.HashValue(s));
    {$ENDIF}
  finally
    idmd5.Free;
  end;
end;
 
function MD5(const str: string): string;
{$IFDEF NewIndy}
var
  idmd5: TIdHashMessageDigest5;
begin
  idmd5 := TIdHashMessageDigest5.Create;
  try
    result := idmd5.HashStringAsHex(str,IndyTextEncoding_OSDefault);
  finally
    idmd5.Free;
  end;
{$ELSE}
var
  ss: TStringStream;
begin
  ss := TStringStream.Create(str);
  try
    result := MD5Stream(ss);
  finally
    ss.Free;
  end;
{$ENDIF}
end;
 
 
end.
 

Rev 75	Rev 91
1	unit Functions;	1	unit Functions;
2		2
3	interface	3	interface
4		4
5	uses	5	uses
6	Windows, Messages, SysUtils, StrUtils, IniFiles, Classes, Forms, Variants, MsHTML,	6	Windows, Messages, SysUtils, StrUtils, IniFiles, Classes, Forms, Variants, MsHTML,
7	StdCtrls, SynEdit, ActiveX;	7	StdCtrls, SynEdit, ActiveX;
8		8
9	type	9	type
10	TContentCallBack = procedure(Content: string) of object;	10	TContentCallBack = procedure(Content: string) of object;
11		11
12	function GetDosOutput(CommandLine: string; Work: string = ''; ContentCallBack: TContentCallBack=nil): string;	12	function GetDosOutput(CommandLine: string; Work: string = ''; ContentCallBack: TContentCallBack=nil): String;
13	function StrIPos(const SubStr, S: string): Integer;	13	function StrIPos(const SubStr, S: string): Integer;
14	function LoadFileToStr(const FileName: TFileName): AnsiString;	14	function LoadFileToStr(const FileName: TFileName): AnsiString;
15	function LastPos(const SubStr, S: string): integer;	15	function LastPos(const SubStr, S: string): integer;
16	function IsTextHTML(s: string): boolean;	16	function IsTextHTML(s: string): boolean;
17	function GetWordUnderPos(AMemo: TSynEdit; Line, Column: integer): string;	17	function GetWordUnderPos(AMemo: TSynEdit; Line, Column: integer): string;
18	function GetWordUnderCaret(AMemo: TSynEdit): string;	18	function GetWordUnderCaret(AMemo: TSynEdit): string;
19	function MyVarToStr(v: Variant): string;	19	function MyVarToStr(v: Variant): string;
20	function FileSystemCaseSensitive: boolean;	20	function FileSystemCaseSensitive: boolean;
21	function HighColorWindows: boolean;	21	function HighColorWindows: boolean;
22	function GetTempDir: string;	22	function GetTempDir: string;
23	function GetSpecialFolder(const aCSIDL: Integer): string;	23	function GetSpecialFolder(const aCSIDL: Integer): string;
24	function GetMyDocumentsFolder: string;	24	function GetMyDocumentsFolder: string;
25	function MD5(const str: string): string;	25	function MD5(const str: string): string;
26	function MD5Stream(const s: TStream): string;	26	function MD5Stream(const s: TStream): string;
27		27
28	implementation	28	implementation
29		29
30	uses	30	uses
31	ShlObj, // Needed for the CSIDL constants	31	ShlObj, // Needed for the CSIDL constants
32	IdGlobal, IdHash, IdHashMessageDigest; // used for MD5 calculation	32	IdGlobal, IdHash, IdHashMessageDigest; // used for MD5 calculation
33		33
34	function GetDosOutput(CommandLine: string; Work: string = ''; ContentCallBack: TContentCallBack=nil): string;	34	function GetDosOutput(CommandLine: string; Work: string = ''; ContentCallBack: TContentCallBack=nil): String;
35	var	35	var
36	SA: TSecurityAttributes;	36	SA: TSecurityAttributes;
37	SI: TStartupInfo;	37	SI: TStartupInfo;
38	PI: TProcessInformation;	38	PI: TProcessInformation;
39	StdOutPipeRead, StdOutPipeWrite: THandle;	39	StdOutPipeRead, StdOutPipeWrite: THandle;
40	WasOK: Boolean;	40	WasOK: Boolean;
41	Buffer: array[0..255] of AnsiChar;	41	Buffer: array[0..255] of AnsiChar;
42	BytesRead: Cardinal;	42	BytesRead: Cardinal;
43	WorkDir: string;	43	WorkDir: string;
44	Handle: Boolean;	44	Handle: Boolean;
45	begin	45	begin
46	if Work = '' then Work := ExtractFilePath(ParamStr(0));	46	if Work = '' then Work := ExtractFilePath(ParamStr(0));
47		47
48	Result := '';	48	Result := '';
49	with SA do begin	49	with SA do begin
50	nLength := SizeOf(SA);	50	nLength := SizeOf(SA);
51	bInheritHandle := True;	51	bInheritHandle := True;
52	lpSecurityDescriptor := nil;	52	lpSecurityDescriptor := nil;
53	end;	53	end;
54	CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);	54	CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
55	try	55	try
56	with SI do	56	with SI do
57	begin	57	begin
58	FillChar(SI, SizeOf(SI), 0);	58	FillChar(SI, SizeOf(SI), 0);
59	cb := SizeOf(SI);	59	cb := SizeOf(SI);
60	dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;	60	dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
61	wShowWindow := SW_HIDE;	61	wShowWindow := SW_HIDE;
62	hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin	62	hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
63	hStdOutput := StdOutPipeWrite;	63	hStdOutput := StdOutPipeWrite;
64	hStdError := StdOutPipeWrite;	64	hStdError := StdOutPipeWrite;
65	end;	65	end;
66	WorkDir := Work;	66	WorkDir := Work;
67	Handle := CreateProcess(nil, PChar('cmd.exe /C "' + CommandLine + '"'),	67	Handle := CreateProcess(nil, PChar('cmd.exe /C "' + CommandLine + '"'),
68	nil, nil, True, 0, nil,	68	nil, nil, True, 0, nil,
69	PChar(WorkDir), SI, PI);	69	PChar(WorkDir), SI, PI);
70	CloseHandle(StdOutPipeWrite);	70	CloseHandle(StdOutPipeWrite);
71	if Handle then	71	if Handle then
72	try	72	try
73	repeat	73	repeat
74	WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);	74	WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
75	if BytesRead > 0 then	75	if BytesRead > 0 then
76	begin	76	begin
77	Buffer[BytesRead] := #0;	77	Buffer[BytesRead] := #0;
78	Result := Result + Buffer;	78	Result := Result + string(Buffer);
79	if Assigned(ContentCallBack) then ContentCallBack(Buffer);	79	if Assigned(ContentCallBack) then ContentCallBack(string(Buffer));
80	end;	80	end;
81	until not WasOK or (BytesRead = 0);	81	until not WasOK or (BytesRead = 0);
82	WaitForSingleObject(PI.hProcess, INFINITE);	82	WaitForSingleObject(PI.hProcess, INFINITE);
83	finally	83	finally
84	CloseHandle(PI.hThread);	84	CloseHandle(PI.hThread);
85	CloseHandle(PI.hProcess);	85	CloseHandle(PI.hProcess);
86	end;	86	end;
87	finally	87	finally
88	CloseHandle(StdOutPipeRead);	88	CloseHandle(StdOutPipeRead);
89	end;	89	end;
90	end;	90	end;
91		91
92	function StrIPos(const SubStr, S: string): Integer;	92	function StrIPos(const SubStr, S: string): Integer;
93	begin	93	begin
94	Result := Pos(UpperCase(SubStr), UpperCase(S));	94	Result := Pos(UpperCase(SubStr), UpperCase(S));
95	end;	95	end;
96		96
97	function LoadFileToStr(const FileName: TFileName): AnsiString;	97	function LoadFileToStr(const FileName: TFileName): AnsiString;
98	var	98	var
99	FileStream : TFileStream;	99	FileStream : TFileStream;
100		100
101	begin	101	begin
102	Result:= '';	102	Result := '';
103	FileStream:= TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);	103	FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
104	try	104	try
105	if FileStream.Size>0 then begin	105	if FileStream.Size>0 then begin
106	SetLength(Result, FileStream.Size);	106	SetLength(Result, FileStream.Size);
107	FileStream.Read(Result[1], FileStream.Size);	107	FileStream.Read(Result[1], FileStream.Size);
108	end;	108	end;
109	finally	109	finally
110	FileStream.Free;	110	FileStream.Free;
111	end;	111	end;
112	end;	112	end;
113		113
114	function LastPos(const SubStr, S: string): integer;	114	function LastPos(const SubStr, S: string): integer;
115	var	115	var
116	I, J, K: integer;	116	I, J, K: integer;
117	begin	117	begin
118	Result := 0;	118	Result := 0;
119	I := Length(S);	119	I := Length(S);
120	K := Length(SubStr);	120	K := Length(SubStr);
121	if (K = 0) or (K > I) then	121	if (K = 0) or (K > I) then
122	Exit;	122	Exit;
123	while (Result = 0) and (I >= K) do	123	while (Result = 0) and (I >= K) do
124	begin	124	begin
125	J := K;	125	J := K;
126	if S[I] = SubStr[J] then	126	if S[I] = SubStr[J] then
127	begin	127	begin
128	while (J > 1) and (S[I + J - K - 1] = SubStr[J - 1]) do	128	while (J > 1) and (S[I + J - K - 1] = SubStr[J - 1]) do
129	Dec(J);	129	Dec(J);
130	if J = 1 then	130	if J = 1 then
131	Result := I - K + 1;	131	Result := I - K + 1;
132	end;	132	end;
133	Dec(I);	133	Dec(I);
134	end;	134	end;
135	end;	135	end;
136		136
137	function IsTextHTML(s: string): boolean;	137	function IsTextHTML(s: string): boolean;
138		138
139	function _Tag(const tag: string): integer;	139	function _Tag(const tag: string): integer;
140	begin	140	begin
141	result := 0;	141	result := 0;
142	if (StrIPos('<'+tag+'>', s) > 0) then Inc(result);	142	if (StrIPos('<'+tag+'>', s) > 0) then Inc(result);
143	if (StrIPos('</'+tag+'>', s) > 0) then Inc(result);	143	if (StrIPos('</'+tag+'>', s) > 0) then Inc(result);
144	if (StrIPos('<'+tag+' />', s) > 0) then Inc(result);	144	if (StrIPos('<'+tag+' />', s) > 0) then Inc(result);
145	if (StrIPos('<'+tag+' ', s) > 0) then Inc(result);	145	if (StrIPos('<'+tag+' ', s) > 0) then Inc(result);
146	end;	146	end;
147		147
148	procedure _Check(const tag: string; pair: boolean);	148	procedure _Check(const tag: string; pair: boolean);
149	begin	149	begin
150	if (pair and (_Tag(tag) >= 2)) or (not pair and (_Tag(tag) >= 1)) then result := true;	150	if (pair and (_Tag(tag) >= 2)) or (not pair and (_Tag(tag) >= 1)) then result := true;
151	end;	151	end;
152		152
153	begin	153	begin
154	result := false;	154	result := false;
155	_Check('html', true);	155	_Check('html', true);
156	_Check('body', true);	156	_Check('body', true);
157	_Check('p', false{end tag optional});	157	_Check('p', false{end tag optional});
158	_Check('a', true);	158	_Check('a', true);
159	_Check('b', true);	159	_Check('b', true);
160	_Check('i', true);	160	_Check('i', true);
161	_Check('u', true);	161	_Check('u', true);
162	_Check('li', false{end tag optional});	162	_Check('li', false{end tag optional});
163	_Check('ol', true);	163	_Check('ol', true);
164	_Check('ul', true);	164	_Check('ul', true);
165	_Check('img', false);	165	_Check('img', false);
166	_Check('div', false);	166	_Check('div', false);
167	_Check('hr', false);	167	_Check('hr', false);
168	_Check('code', true);	168	_Check('code', true);
169	_Check('pre', true);	169	_Check('pre', true);
170	_Check('blockquote', true);	170	_Check('blockquote', true);
171	_Check('span', true);	171	_Check('span', true);
172	_Check('br', false);	172	_Check('br', false);
173	end;	173	end;
174		174
175	// Template: http://stackoverflow.com/questions/6339446/delphi-get-the-whole-word-where-the-caret-is-in-a-memo	175	// Template: http://stackoverflow.com/questions/6339446/delphi-get-the-whole-word-where-the-caret-is-in-a-memo
176	function GetWordUnderPos(AMemo: TSynEdit; Line, Column: integer): string;	176	function GetWordUnderPos(AMemo: TSynEdit; Line, Column: integer): string;
177		177
178	function ValidChar(c: char): boolean;	178	function ValidChar(c: char): boolean;
179	begin	179	begin
180	{$IFDEF UNICODE}	180	{$IFDEF UNICODE}
181	result := CharInSet(c, ['a'..'z', 'A'..'Z', '0'..'9', '_']);	181	result := CharInSet(c, ['a'..'z', 'A'..'Z', '0'..'9', '_']);
182	{$ELSE}	182	{$ELSE}
183	result := c in ['a'..'z', 'A'..'Z', '0'..'9', '_'];	183	result := c in ['a'..'z', 'A'..'Z', '0'..'9', '_'];
184	{$ENDIF}	184	{$ENDIF}
185	end;	185	end;
186		186
187	var	187	var
188	LineText: string;	188	LineText: string;
189	InitPos : Integer;	189	InitPos : Integer;
190	EndPos : Integer;	190	EndPos : Integer;
191	begin	191	begin
192	//Validate the line number	192	//Validate the line number
193	if AMemo.Lines.Count-1 < Line then Exit;	193	if AMemo.Lines.Count-1 < Line then Exit;
194		194
195	//Get the text of the line	195	//Get the text of the line
196	LineText := AMemo.Lines[Line];	196	LineText := AMemo.Lines[Line];
197		197
198	if LineText = '' then	198	if LineText = '' then
199	begin	199	begin
200	result := '';	200	result := '';
201	exit;	201	exit;
202	end;	202	end;
203		203
204	// Column zeigt auf das Zeichen LINKS vom Cursor!	204	// Column zeigt auf das Zeichen LINKS vom Cursor!
205		205
206	InitPos := Column;	206	InitPos := Column;
207	if not ValidChar(LineText[InitPos]) then Inc(InitPos);	207	if not ValidChar(LineText[InitPos]) then Inc(InitPos);
208	while (InitPos-1 >= 1) and ValidChar(LineText[InitPos-1]) do Dec(InitPos);	208	while (InitPos-1 >= 1) and ValidChar(LineText[InitPos-1]) do Dec(InitPos);
209		209
210	EndPos := Column;	210	EndPos := Column;
211	while (EndPos+1 <= Length(LineText)) and ValidChar(LineText[EndPos+1]) do Inc(EndPos);	211	while (EndPos+1 <= Length(LineText)) and ValidChar(LineText[EndPos+1]) do Inc(EndPos);
212		212
213	//Get the text	213	//Get the text
214	Result := Copy(LineText, InitPos, EndPos - InitPos + 1);	214	Result := Copy(LineText, InitPos, EndPos - InitPos + 1);
215	end;	215	end;
216		216
217	function GetWordUnderCaret(AMemo: TSynEdit): string;	217	function GetWordUnderCaret(AMemo: TSynEdit): string;
218	var	218	var
219	Line : Integer;	219	Line : Integer;
220	Column : Integer;	220	Column : Integer;
221	begin	221	begin
222	//Get the caret position	222	//Get the caret position
223	(*	223	(*
224	if AMemo is TMemo then	224	if AMemo is TMemo then
225	begin	225	begin
226	Line := AMemo.Perform(EM_LINEFROMCHAR,AMemo.SelStart, 0);	226	Line := AMemo.Perform(EM_LINEFROMCHAR,AMemo.SelStart, 0);
227	Column := AMemo.SelStart - AMemo.Perform(EM_LINEINDEX, Line, 0);	227	Column := AMemo.SelStart - AMemo.Perform(EM_LINEINDEX, Line, 0);
228	end;	228	end;
229	if AMemo is TSynEdit then	229	if AMemo is TSynEdit then
230	begin	230	begin
231	*)	231	*)
232	Line := AMemo.CaretY-1;	232	Line := AMemo.CaretY-1;
233	Column := AMemo.CaretX-1;	233	Column := AMemo.CaretX-1;
234	(*	234	(*
235	end;	235	end;
236	*)	236	*)
237		237
238	result := GetWordUnderPos(AMemo, Line, Column);	238	result := GetWordUnderPos(AMemo, Line, Column);
239	end;	239	end;
240		240
241	function MyVarToStr(v: Variant): string;	241	function MyVarToStr(v: Variant): string;
242	var	242	var
243	_Lo, _Hi, i: integer;	243	_Lo, _Hi, i: integer;
244	begin	244	begin
245	if VarIsNull(v) then	245	if VarIsNull(v) then
246	begin	246	begin
247	result := '';	247	result := '';
248	end	248	end
249	else if VarIsArray(v) then	249	else if VarIsArray(v) then
250	begin	250	begin
251	_Lo := VarArrayLowBound(v, 1);	251	_Lo := VarArrayLowBound(v, 1);
252	_Hi := VarArrayHighBound(v, 1);	252	_Hi := VarArrayHighBound(v, 1);
253	result := '';	253	result := '';
254	for i := _Lo to _Hi do	254	for i := _Lo to _Hi do
255	begin	255	begin
256	if v[i] = 0 then break;	256	if v[i] = 0 then break;
257	result := result + chr(integer(v[i]));	257	result := result + chr(integer(v[i]));
258	end;	258	end;
259	end	259	end
260	else	260	else
261	begin	261	begin
262	// At least try it...	262	// At least try it...
263	result := VarToStr(v);	263	result := VarToStr(v);
264	end;	264	end;
265	end;	265	end;
266		266
267	function FileSystemCaseSensitive: boolean;	267	function FileSystemCaseSensitive: boolean;
268	begin	268	begin
269	// TODO: This code is not very reliable. At MAC OSX, the file system HFS can be switched	269	// TODO: This code is not very reliable. At MAC OSX, the file system HFS can be switched
270	// between case sensitivity and insensitivity.	270	// between case sensitivity and insensitivity.
271	{$IFDEF LINUX}	271	{$IFDEF LINUX}
272	exit(true);	272	exit(true);
273	{$ELSE}	273	{$ELSE}
274	result := false;	274	result := false;
275	exit;	275	exit;
276	{$ENDIF}	276	{$ENDIF}
277	end;	277	end;
278		278
279	function HighColorWindows: boolean;	279	function HighColorWindows: boolean;
280	var	280	var
281	ver: Cardinal;	281	ver: Cardinal;
282	dwMajorVersion, dwMinorVersion: integer;	282	dwMajorVersion, dwMinorVersion: integer;
283	begin	283	begin
284	ver := GetVersion();	284	ver := GetVersion();
285	dwMajorVersion := Lo(ver);	285	dwMajorVersion := Lo(ver);
286	dwMinorVersion := Hi(ver);	286	dwMinorVersion := Hi(ver);
287		287
288	// Gradient fitting in:	288	// Gradient fitting in:
289	// 5.1 = XP	289	// 5.1 = XP
290	// 5.2 = Windows Server 2003	290	// 5.2 = Windows Server 2003
291	// 6.0 = Vista	291	// 6.0 = Vista
292	// 6.1 = Win7	292	// 6.1 = Win7
293		293
294	result := ((dwMajorVersion = 5) and (dwMinorVersion >= 1)) or	294	result := ((dwMajorVersion = 5) and (dwMinorVersion >= 1)) or
295	((dwMajorVersion = 6) and (dwMinorVersion <= 1));	295	((dwMajorVersion = 6) and (dwMinorVersion <= 1));
296	end;	296	end;
297		297
298	function GetTempDir: string;	298	function GetTempDir: string;
299	var	299	var
300	Dir: string;	300	Dir: string;
301	Len: DWord;	301	Len: DWord;
302	begin	302	begin
303	SetLength(Dir,MAX_PATH);	303	SetLength(Dir,MAX_PATH);
304	Len:=GetTempPath(MAX_PATH, PChar(Dir));	304	Len:=GetTempPath(MAX_PATH, PChar(Dir));
305	if Len>0 then	305	if Len>0 then
306	begin	306	begin
307	SetLength(Dir,Len);	307	SetLength(Dir,Len);
308	Result:=Dir;	308	Result:=Dir;
309	end	309	end
310	else	310	else
311	RaiseLastOSError;	311	RaiseLastOSError;
312	end;	312	end;
313		313
314	function SHGetFolderPath(hwnd: HWND; csidl: Integer; hToken: THandle;	314	function SHGetFolderPath(hwnd: HWND; csidl: Integer; hToken: THandle;
315	dwFlags: DWord; pszPath: LPWSTR): HRESULT; stdcall;	315	dwFlags: DWord; pszPath: LPWSTR): HRESULT; stdcall;
316	external 'SHFolder.dll' name 'SHGetFolderPathW';	316	external 'SHFolder.dll' name 'SHGetFolderPathW';
317		317
318	function GetSpecialFolder(const aCSIDL: Integer): string;	318	function GetSpecialFolder(const aCSIDL: Integer): string;
319	var	319	var
320	FolderPath: array[0 .. MAX_PATH] of Char;	320	FolderPath: array[0 .. MAX_PATH] of Char;
321	begin	321	begin
322	SetLastError(ERROR_SUCCESS);	322	SetLastError(ERROR_SUCCESS);
323	if SHGetFolderPath(0, aCSIDL, 0, 0, @FolderPath) = S_OK then	323	if SHGetFolderPath(0, aCSIDL, 0, 0, @FolderPath) = S_OK then
324	Result := FolderPath;	324	Result := FolderPath;
325	end;	325	end;
326		326
327	function GetMyDocumentsFolder: string;	327	function GetMyDocumentsFolder: string;
328	begin	328	begin
329	Result := GetSpecialFolder(CSIDL_PERSONAL);	329	Result := GetSpecialFolder(CSIDL_PERSONAL);
330	end;	330	end;
331		331
332		332
333	{$IF gsIdVersion <> '10.1.5'} // Delphi 2007 built-in Indy10; gsIdVersion requires idGlobal.pas	333	{$IF gsIdVersion <> '10.1.5'} // Delphi 2007 built-in Indy10; gsIdVersion requires idGlobal.pas
334	{$DEFINE NewIndy}	334	{$DEFINE NewIndy}
335	{$IFEND}	335	{$IFEND}
336		336
337	function MD5Stream(const s: TStream): string;	337	function MD5Stream(const s: TStream): string;
338	var	338	var
339	idmd5: TIdHashMessageDigest5;	339	idmd5: TIdHashMessageDigest5;
340	begin	340	begin
341	idmd5 := TIdHashMessageDigest5.Create;	341	idmd5 := TIdHashMessageDigest5.Create;
342	try	342	try
343	{$IFDEF NewIndy}	343	{$IFDEF NewIndy}
344	result := idmd5.HashStreamAsHex(s);	344	result := idmd5.HashStreamAsHex(s);
345	{$ELSE}	345	{$ELSE}
346	result := idmd5.AsHex(idmd5.HashValue(s));	346	result := idmd5.AsHex(idmd5.HashValue(s));
347	{$ENDIF}	347	{$ENDIF}
348	finally	348	finally
349	idmd5.Free;	349	idmd5.Free;
350	end;	350	end;
351	end;	351	end;
352		352
353	function MD5(const str: string): string;	353	function MD5(const str: string): string;
354	{$IFDEF NewIndy}	354	{$IFDEF NewIndy}
355	var	355	var
356	idmd5: TIdHashMessageDigest5;	356	idmd5: TIdHashMessageDigest5;
357	begin	357	begin
358	idmd5 := TIdHashMessageDigest5.Create;	358	idmd5 := TIdHashMessageDigest5.Create;
359	try	359	try
360	result := idmd5.HashStringAsHex(str,IndyTextEncoding_OSDefault);	360	result := idmd5.HashStringAsHex(str,IndyTextEncoding_OSDefault);
361	finally	361	finally
362	idmd5.Free;	362	idmd5.Free;
363	end;	363	end;
364	{$ELSE}	364	{$ELSE}
365	var	365	var
366	ss: TStringStream;	366	ss: TStringStream;
367	begin	367	begin
368	ss := TStringStream.Create(str);	368	ss := TStringStream.Create(str);
369	try	369	try
370	result := MD5Stream(ss);	370	result := MD5Stream(ss);
371	finally	371	finally
372	ss.Free;	372	ss.Free;
373	end;	373	end;
374	{$ENDIF}	374	{$ENDIF}
375	end;	375	end;
376		376
377		377
378	end.	378	end.
379		379

Subversion Repositories fastphp

fastphp/trunk/Functions.pas – Rev 75 → 91