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 115 by tony, Fri Jan 19 09:23:39 2018 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

#	Line 33 | Line 33
33
34		unit IBUtils;
35		{$IFDEF MSWINDOWS}
36	<	{$DEFINE WINDOWS}
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 Classes, SysUtils;
48	>	uses Classes, SysUtils, IB;
49
50		const
51		CRLF = #13 + #10;
#	Line 258 | Line 260 | function Min(n1, n2: Integer): Integer;
260		function RandomString(iLength: Integer): AnsiString;
261		function RandomInteger(iLow, iHigh: Integer): Integer;
262		function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
261	–	function FormatIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
262	–	function FormatIdentifierValue(Dialect: Integer; Value: AnsiString): AnsiString;
263	–	function FormatIdentifierValueNC(Dialect: Integer; Value: 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 311 | Line 321 | begin
321		end;
322		end;
323
324	<	function FormatIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
315	<	begin
316	<	Value := Trim(Value);
317	<	if Dialect = 1 then
318	<	Value := AnsiUpperCase(Value)
319	<	else
320	<	if (Value <> '') and (Value[1] = '"') then
321	<	Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
322	<	else
323	<	Value := AnsiUpperCase(Value);
324	<	Result := Value;
325	<	end;
324	>	{Extracts SQL Identifier typically from a  Dialect 3 encoding}
325
326	<	function FormatIdentifierValue(Dialect: Integer; Value: AnsiString): AnsiString;
326	>	function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
327		begin
328		Value := Trim(Value);
329		if Dialect = 1 then
#	Line 343 | Line 342 | begin
342		Result := Value;
343		end;
344
345	<	function FormatIdentifierValueNC(Dialect: Integer; Value: AnsiString): AnsiString;
347	<	begin
348	<	Value := Trim(Value);
349	<	if Dialect = 1 then
350	<	Value := AnsiUpperCase(Value)
351	<	else
352	<	begin
353	<	if (Value <> '') and (Value[1] = '"') then
354	<	begin
355	<	Delete(Value, 1, 1);
356	<	Delete(Value, Length(Value), 1);
357	<	Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
358	<	end
359	<	else
360	<	Value := AnsiUpperCase(Value);
361	<	end;
362	<	Result := Value;
363	<	end;
364	<
365	<	function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
366	<	begin
367	<	Value := Trim(Value);
368	<	if Dialect = 1 then
369	<	Value := AnsiUpperCase(Value)
370	<	else
371	<	begin
372	<	if (Value <> '') and (Value[1] = '"') then
373	<	begin
374	<	Delete(Value, 1, 1);
375	<	Delete(Value, Length(Value), 1);
376	<	Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
377	<	end
378	<	else
379	<	Value := AnsiUpperCase(Value);
380	<	end;
381	<	Result := Value;
382	<	end;
345	>	{Returns true if "w" is a Firebird SQL reserved word}
346
347		function IsReservedWord(w: AnsiString): boolean;
348		var i: integer;
#	Line 391 | Line 354 | begin
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
361		if Dialect = 1 then
362		Value := AnsiUpperCase(Trim(Value))
363		else
364	<	Value := '"' + Value + '"';
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
#	Line 412 | Line 379 | begin
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	+	{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	+	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;
479	+	end;
480	+
481	+	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
482	+	var ServerName,
483	+	DatabaseName: AnsiString;
484	+	PortNo: AnsiString;
485	+	begin
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	+	ConnectString := CreateSQL;
501	+	delete(ConnectString,1,i);
502	+	i := Pos('''',ConnectString);
503	+	if i > 0 then
504	+	begin
505	+	delete(ConnectString,i,Length(ConnectString)-i+1);
506	+	Result := true;
507	+	end;
508	+	end;
509	+	end;
510	+
511	+	function GetProtocol(ConnectString: AnsiString): TProtocolAll;
512	+	begin
513	+	Result := unknownProtocol; {not implemented for Delphi}
514	+	end;
515	+
516	+	function ParseConnectString(ConnectString: AnsiString;
517	+	var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
518	+	var PortNo: AnsiString): boolean;
519	+	begin
520	+	Result := false;
521	+	end;
522	+
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		(IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
560	<	Result := '"' + Value + '"'
560	>	Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
561		else
562		Result := Value
563		end;
564
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	+	{Reformats an SQL string with single quotes duplicated.}
578	+
579		function SQLSafeString(const s: AnsiString): AnsiString;
580		begin
581		Result := StringReplace(s,'''','''''',[rfReplaceAll]);

Diff Legend

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