ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/branches/udr/client/IBUtils.pas

Comparing ibx/trunk/fbintf/IBUtils.pas (file contents):
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 32 | Line 32
32		{************************************************************************}
33
34		unit IBUtils;
35	+	{$IFDEF MSWINDOWS}
36	+	{$DEFINE WINDOWS}
37	+	{$ENDIF}
38
39		{$IFDEF FPC}
40		{$Mode Delphi}
41		{$codepage UTF8}
42	+	{$define HASREQEX}
43		{$ENDIF}
44
45	+
46		interface
47
48	<	uses
44	<	{$IFDEF WINDOWS }
45	<	Windows,
46	<	{$ELSE}
47	<	unix,
48	<	{$ENDIF}
49	<	Classes, SysUtils;
48	>	uses Classes, SysUtils, IB;
49
50		const
51		CRLF = #13 + #10;
#	Line 258 | Line 257 | const
257
258		function Max(n1, n2: Integer): Integer;
259		function Min(n1, n2: Integer): Integer;
260	<	function RandomString(iLength: Integer): String;
260	>	function RandomString(iLength: Integer): AnsiString;
261		function RandomInteger(iLow, iHigh: Integer): Integer;
262	<	function StripString(st: String; CharsToStrip: String): String;
263	<	function FormatIdentifier(Dialect: Integer; Value: String): String;
264	<	function FormatIdentifierValue(Dialect: Integer; Value: String): String;
265	<	function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
266	<	function ExtractIdentifier(Dialect: Integer; Value: String): String;
267	<	function QuoteIdentifier(Dialect: Integer; Value: String): String;
268	<	function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
269	<	function Space2Underscore(s: string): string;
270	<	function SQLSafeString(const s: string): string;
262	>	function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
263	>	function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
264	>	function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
265	>	function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
266	>	function Space2Underscore(s: AnsiString): AnsiString;
267	>	function SQLSafeString(const s: AnsiString): AnsiString;
268	>	function IsSQLIdentifier(Value: AnsiString): boolean;
269	>	function ExtractConnectString(const CreateSQL: AnsiString; var ConnectString: AnsiString): boolean;
270	>	function MakeConnectString(ServerName, DatabaseName: AnsiString; Protocol: TProtocol;
271	>	PortNo: AnsiString = ''): AnsiString;
272	>	function ParseConnectString(ConnectString: AnsiString;
273	>	var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
274	>	var PortNo: AnsiString): boolean;
275	>	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
276
277		implementation
278
279	+	{$IFDEF HASREQEX}
280	+	uses RegExpr;
281	+	{$ENDIF}
282	+
283		function Max(n1, n2: Integer): Integer;
284		begin
285		if (n1 > n2) then
#	Line 288 | Line 296 | begin
296		result := n2;
297		end;
298
299	<	function RandomString(iLength: Integer): String;
299	>	function RandomString(iLength: Integer): AnsiString;
300		begin
301		result := '';
302		while Length(result) < iLength do
#	Line 302 | Line 310 | begin
310		result := Trunc(Random(iHigh - iLow)) + iLow;
311		end;
312
313	<	function StripString(st: String; CharsToStrip: String): String;
313	>	function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
314		var
315		i: Integer;
316		begin
#	Line 313 | Line 321 | begin
321		end;
322		end;
323
324	<	function FormatIdentifier(Dialect: Integer; Value: String): String;
317	<	begin
318	<	Value := Trim(Value);
319	<	if Dialect = 1 then
320	<	Value := AnsiUpperCase(Value)
321	<	else
322	<	if (Value <> '') and (Value[1] = '"') then
323	<	Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
324	<	else
325	<	Value := AnsiUpperCase(Value);
326	<	Result := Value;
327	<	end;
324	>	{Extracts SQL Identifier typically from a  Dialect 3 encoding}
325
326	<	function FormatIdentifierValue(Dialect: Integer; Value: String): String;
326	>	function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
327		begin
328		Value := Trim(Value);
329		if Dialect = 1 then
#	Line 345 | Line 342 | begin
342		Result := Value;
343		end;
344
345	<	function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
345	>	{Returns true if "w" is a Firebird SQL reserved word}
346	>
347	>	function IsReservedWord(w: AnsiString): boolean;
348	>	var i: integer;
349	>	begin
350	>	Result := true;
351	>	for i := 0 to Length(sqlReservedWords) - 1 do
352	>	if w = sqlReservedWords[i] then
353	>	Exit;
354	>	Result := false;
355	>	end;
356	>
357	>	{Format an SQL Identifier according to SQL Dialect}
358	>
359	>	function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
360		begin
350	–	Value := Trim(Value);
361		if Dialect = 1 then
362	<	Value := AnsiUpperCase(Value)
362	>	Value := AnsiUpperCase(Trim(Value))
363		else
364	<	begin
365	<	if (Value <> '') and (Value[1] = '"') then
364	>	Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
365	>	Result := Value;
366	>	end;
367	>
368	>	const
369	>	ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];
370	>
371	>	{Returns true if the value is a valid SQL Identifier - note lower case accepted}
372	>
373	>	function IsSQLIdentifier(Value: AnsiString): boolean;
374	>	var i: integer;
375	>	begin
376	>	Result := false;
377	>	for i := 1 to Length(Value) do
378	>	if not (Value[i] in ValidSQLIdentifierChars) then Exit;
379	>	Result := true;
380	>	end;
381	>
382	>	{Extracts the Database Connect string from a Create Database Statement}
383	>
384	>	{$IFDEF HASREQEX}
385	>	function ExtractConnectString(const CreateSQL: AnsiString;
386	>	var ConnectString: AnsiString): boolean;
387	>	var RegexObj: TRegExpr;
388	>	begin
389	>	RegexObj := TRegExpr.Create;
390	>	try
391	>	{extact database file spec}
392	>	RegexObj.ModifierG := false; {turn off greedy matches}
393	>	RegexObj.ModifierI := true; {case insensitive match}
394	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
395	>	Result := RegexObj.Exec(CreateSQL);
396	>	if Result then
397	>	ConnectString := RegexObj.Match[2];
398	>	finally
399	>	RegexObj.Free;
400	>	end;
401	>	end;
402	>
403	>	function ParseConnectString(ConnectString: AnsiString; var ServerName,
404	>	DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
405	>	): boolean;
406	>	var RegexObj: TRegExpr;
407	>	scheme: AnsiString;
408	>	begin
409	>	ServerName := '';
410	>	DatabaseName := ConnectString;
411	>	PortNo := '';
412	>	Protocol := unknownProtocol;
413	>	RegexObj := TRegExpr.Create;
414	>	try
415	>	{extact database file spec}
416	>	RegexObj.ModifierG := false; {turn off greedy matches}
417	>	RegexObj.Expression := '^([a-zA-Z]+)://([a-zA-Z0-9\-\.]+)(|:[0-9a-zA-Z\-]+)/(.*)$';
418	>	Result := RegexObj.Exec(ConnectString);
419	>	if Result then
420		begin
421	<	Delete(Value, 1, 1);
422	<	Delete(Value, Length(Value), 1);
423	<	Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
421	>	{URL type connect string}
422	>	scheme := AnsiUpperCase(RegexObj.Match[1]);
423	>	ServerName := RegexObj.Match[2];
424	>	if RegexObj.MatchLen[3] > 0 then
425	>	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
426	>	DatabaseName := RegexObj.Match[4];
427	>	if scheme = 'INET' then
428	>	Protocol := inet
429	>	else
430	>	if scheme = 'XNET' then
431	>	Protocol := xnet
432	>	else
433	>	if scheme = 'WNET' then
434	>	Protocol := wnet
435		end
436		else
437	<	Value := AnsiUpperCase(Value);
437	>	begin
438	>	RegexObj.Expression := '^([a-zA-Z]:\\.*)';
439	>	Result := RegexObj.Exec(ConnectString);
440	>	if Result then
441	>	Protocol := Local {Windows with leading drive ID}
442	>	else
443	>	begin
444	>	RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
445	>	Result := RegexObj.Exec(ConnectString);
446	>	if Result then
447	>	begin
448	>	{Legacy TCP Format}
449	>	ServerName := RegexObj.Match[1];
450	>	if RegexObj.MatchLen[2] > 0 then
451	>	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
452	>	DatabaseName := RegexObj.Match[3];
453	>	Protocol := TCP;
454	>	end
455	>	else
456	>	begin
457	>	RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
458	>	Result := RegexObj.Exec(ConnectString);
459	>	if Result then
460	>	begin
461	>	{Netbui}
462	>	ServerName := RegexObj.Match[1];
463	>	if RegexObj.MatchLen[2] > 0 then
464	>	PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
465	>	DatabaseName := RegexObj.Match[3];
466	>	Protocol := NamedPipe
467	>	end
468	>	else
469	>	begin
470	>	Result := true;
471	>	Protocol := Local; {Assume local}
472	>	end;
473	>	end;
474	>	end;
475	>	end;
476	>	finally
477	>	RegexObj.Free;
478		end;
364	–	Result := Value;
479		end;
480
481	<	function ExtractIdentifier(Dialect: Integer; Value: String): String;
481	>	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
482	>	var ServerName,
483	>	DatabaseName: AnsiString;
484	>	PortNo: AnsiString;
485		begin
486	<	Value := Trim(Value);
487	<	if Dialect = 1 then
488	<	Value := AnsiUpperCase(Value)
489	<	else
486	>	ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
487	>	end;
488	>
489	>	{$ELSE}
490	>	{cruder version of above for Delphi. Older versions lack regular expression
491	>	handling.}
492	>	function ExtractConnectString(const CreateSQL: AnsiString;
493	>	var ConnectString: AnsiString): boolean;
494	>	var i: integer;
495	>	begin
496	>	Result := false;
497	>	i := Pos('''',CreateSQL);
498	>	if i > 0 then
499		begin
500	<	if (Value <> '') and (Value[1] = '"') then
500	>	ConnectString := CreateSQL;
501	>	delete(ConnectString,1,i);
502	>	i := Pos('''',ConnectString);
503	>	if i > 0 then
504		begin
505	<	Delete(Value, 1, 1);
506	<	Delete(Value, Length(Value), 1);
507	<	Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
379	<	end
380	<	else
381	<	Value := AnsiUpperCase(Value);
505	>	delete(ConnectString,i,Length(ConnectString)-i+1);
506	>	Result := true;
507	>	end;
508		end;
383	–	Result := Value;
509		end;
510
511	<	function IsReservedWord(w: string): boolean;
387	<	var i: integer;
511	>	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
512		begin
513	<	Result := true;
390	<	for i := 0 to Length(sqlReservedWords) - 1 do
391	<	if w = sqlReservedWords[i] then
392	<	Exit;
393	<	Result := false;
513	>	Result := unknownProtocol; {not implemented for Delphi}
514		end;
515
516	<	function QuoteIdentifier(Dialect: Integer; Value: String): String;
516	>	function ParseConnectString(ConnectString: AnsiString;
517	>	var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
518	>	var PortNo: AnsiString): boolean;
519		begin
520	<	if Dialect = 1 then
399	<	Value := AnsiUpperCase(Trim(Value))
400	<	else
401	<	Value := '"' + Value + '"';
402	<	Result := Value;
520	>	Result := false;
521		end;
522
523	<	function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
523	>	{$ENDIF}
524	>
525	>	{Make a connect string in format appropriate protocol}
526	>
527	>	function MakeConnectString(ServerName, DatabaseName: AnsiString;
528	>	Protocol: TProtocol; PortNo: AnsiString): AnsiString;
529	>	begin
530	>	if PortNo <> '' then
531	>	case Protocol of
532	>	NamedPipe:
533	>	ServerName := ServerName + '@' + PortNo;
534	>	Local,
535	>	SPX,
536	>	xnet: {do nothing};
537	>	TCP:
538	>	ServerName := ServerName + '/' + PortNo;
539	>	else
540	>	ServerName := ServerName + ':' + PortNo;
541	>	end;
542	>
543	>	case Protocol of
544	>	TCP:        Result := ServerName + ':' + DatabaseName; {do not localize}
545	>	SPX:        Result := ServerName + '@' + DatabaseName; {do not localize}
546	>	NamedPipe:  Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
547	>	Local:      Result := DatabaseName; {do not localize}
548	>	inet:       Result := 'inet://' + ServerName + '/'+ DatabaseName; {do not localize}
549	>	wnet:       Result := 'wnet://' + ServerName + '/'+ DatabaseName; {do not localize}
550	>	xnet:       Result := 'xnet://' + ServerName + '/'+ DatabaseName;  {do not localize}
551	>	end;
552	>	end;
553	>
554	>	{Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
555	>
556	>	function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
557		begin
558		if (Dialect = 3) and
559	<	((AnsiUpperCase(Value) <> Value) or IsReservedWord(Value)) then
560	<	Result := '"' + Value + '"'
559	>	(IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
560	>	Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
561		else
562		Result := Value
563		end;
564
565	<	function Space2Underscore(s: string): string;
565	>	{Replaces unknown characters in a string with underscores}
566	>
567	>	function Space2Underscore(s: AnsiString): AnsiString;
568		var
569		k: integer;
570		begin
571		Result := s;
572		for k := 1 to Length(s) do
573	<	if not (Result[k] in ['0'..'9','A'..'Z','_','$'])  then
573	>	if not (Result[k] in ValidSQLIdentifierChars)  then
574		Result[k] := '_';
575		end;
576
577	<	function SQLSafeString(const s: string): string;
577	>	{Reformats an SQL string with single quotes duplicated.}
578	>
579	>	function SQLSafeString(const s: AnsiString): AnsiString;
580		begin
581		Result := StringReplace(s,'''','''''',[rfReplaceAll]);
582		end;

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines