ViewVC Help

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

root/public/ibx/trunk/runtime/IBSQL.pas

Comparing ibx/trunk/runtime/IBSQL.pas (file contents):
Revision 4 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC

#	Line 28 | Line 28
28
29		unit IBSQL;
30
31	+	{$Mode Delphi}
32	+
33		interface
34
35		uses
36	<	Windows, SysUtils, Classes, Forms, Controls, IBHeader,
36	>	{$IFDEF LINUX }
37	>	baseunix,unix,
38	>	{$ELSE}
39	>	{$DEFINE HAS_SQLMONITOR}
40	>	Windows,
41	>	{$ENDIF}
42	>	SysUtils, Classes, Forms, Controls, IBHeader,
43		IBErrorCodes, IBExternals, DB, IB, IBDatabase, IBUtils, IBXConst;
44
45		type
#	Line 178 | Line 186 | type
186		{ TIBOutputDelimitedFile }
187		TIBOutputDelimitedFile = class(TIBBatchOutput)
188		protected
189	+	{$IFDEF LINUX}
190	+	FHandle: cint;
191	+	{$ELSE}
192		FHandle: THandle;
193	+	{$ENDIF}
194		FOutputTitles: Boolean;
195		FColDelimiter,
196		FRowDelimiter: string;
#	Line 217 | Line 229 | type
229		{ TIBOutputRawFile }
230		TIBOutputRawFile = class(TIBBatchOutput)
231		protected
232	+	{$IFDEF LINUX}
233	+	FHandle: cint;
234	+	{$ELSE}
235		FHandle: THandle;
236	+	{$ENDIF}
237		public
238		destructor Destroy; override;
239		procedure ReadyFile; override;
#	Line 227 | Line 243 | type
243		{ TIBInputRawFile }
244		TIBInputRawFile = class(TIBBatchInput)
245		protected
246	+	{$IFDEF LINUX}
247	+	FHandle: cint;
248	+	{$ELSE}
249		FHandle: THandle;
250	+	{$ENDIF}
251		public
252		destructor Destroy; override;
253		function ReadParameters: Boolean; override;
#	Line 294 | Line 314 | type
314		function Current: TIBXSQLDA;
315		procedure ExecQuery;
316		function FieldByName(FieldName: String): TIBXSQLVAR;
317	+	function ParamByName(ParamName: String): TIBXSQLVAR;
318		procedure FreeHandle;
319		function Next: TIBXSQLDA;
320		procedure Prepare;
#	Line 328 | Line 349 | type
349		implementation
350
351		uses
352	<	IBIntf, IBBlob, IBSQLMonitor;
352	>	IBIntf, IBBlob, Variants {$IFDEF HAS_SQLMONITOR}, IBSQLMonitor {$ENDIF};
353
354		{ TIBXSQLVAR }
355		constructor TIBXSQLVAR.Create(Parent: TIBXSQLDA; Query: TIBSQL);
#	Line 424 | Line 445 | end;
445
446		function TIBXSQLVAR.AdjustScale(Value: Int64; Scale: Integer): Double;
447		var
448	<	Scaling, i: Integer;
448	>	Scaling : Int64;
449	>	i: Integer;
450		Val: Double;
451		begin
452		Scaling := 1; Val := Value;
#	Line 447 | Line 469 | end;
469
470		function TIBXSQLVAR.AdjustScaleToInt64(Value: Int64; Scale: Integer): Int64;
471		var
472	<	Scaling, i: Integer;
472	>	Scaling : Int64;
473	>	i: Integer;
474		Val: Int64;
475		begin
476		Scaling := 1; Val := Value;
#	Line 463 | Line 486 | end;
486
487		function TIBXSQLVAR.AdjustScaleToCurrency(Value: Int64; Scale: Integer): Currency;
488		var
489	<	Scaling, i : Integer;
489	>	Scaling : Int64;
490	>	i : Integer;
491		FractionText, PadText, CurrText: string;
492		begin
493	<	result := Value;
493	>	Result := 0;
494		Scaling := 1;
495		if Scale > 0 then
496		begin
#	Line 489 | Line 513 | begin
513		try
514		result := StrToCurr(CurrText);
515		except
516	<	on E: Exception do IBError(ibxeInvalidDataConversion, [nil]);
516	>	on E: Exception do
517	>	IBError(ibxeInvalidDataConversion, [nil]);
518		end;
519	<	end;
519	>	end
520	>	else
521	>	result := Value;
522		end;
523
524		function TIBXSQLVAR.GetAsCurrency: Currency;
#	Line 1294 | Line 1321 | begin
1321		if FParent.FNames[i] = FName then
1322		begin
1323		xvar := FParent[i];
1324	<	xvar.FXSQLVAR^.sqlind^ := -1;
1325	<	xvar.FModified := True;
1299	<	end;
1300	<	end else if ((not Value) and IsNullable) then
1301	<	begin
1302	<	for i := 0 to FParent.FCount - 1 do
1303	<	if FParent.FNames[i] = FName then
1304	<	begin
1305	<	xvar := FParent[i];
1306	<	xvar.FXSQLVAR^.sqlind^ := 0;
1324	>	if Assigned(xvar.FXSQLVAR^.sqlind) then
1325	>	xvar.FXSQLVAR^.sqlind^ := -1;
1326		xvar.FModified := True;
1327		end;
1328	<	end;
1328	>	end
1329	>	else
1330	>	if ((not Value) and IsNullable) then
1331	>	begin
1332	>	for i := 0 to FParent.FCount - 1 do
1333	>	if FParent.FNames[i] = FName then
1334	>	begin
1335	>	xvar := FParent[i];
1336	>	if Assigned(xvar.FXSQLVAR^.sqlind) then
1337	>	xvar.FXSQLVAR^.sqlind^ := 0;
1338	>	xvar.FModified := True;
1339	>	end;
1340	>	end;
1341		end;
1342
1343		procedure TIBXSQLVAR.SetIsNullable(Value: Boolean);
#	Line 1361 | Line 1392 | begin
1392		FXSQLDA := nil;
1393		FXSQLVARs := nil;
1394		end;
1395	<	inherited;
1395	>	inherited Destroy;
1396		end;
1397
1398		procedure TIBXSQLDA.AddName(FieldName: String; Idx: Integer);
#	Line 1442 | Line 1473 | var
1473		begin
1474		bUnique := True;
1475		NamesWereEmpty := (FNames.Count = 0);
1476	<	if FXSQLDA <> nil then begin
1477	<	for i := 0 to FCount - 1 do begin
1478	<	with FXSQLVARs[i].Data^ do begin
1479	<	if bUnique and (String(relname) <> '') then
1476	>	if FXSQLDA <> nil then
1477	>	begin
1478	>	for i := 0 to FCount - 1 do
1479	>	begin
1480	>	with FXSQLVARs[i].Data^ do
1481	>	begin
1482	>	if bUnique and (strpas(relname) <> '') then
1483		begin
1484		if FUniqueRelationName = '' then
1485	<	FUniqueRelationName := String(relname)
1486	<	else if String(relname) <> FUniqueRelationName then
1487	<	begin
1488	<	FUniqueRelationName := '';
1489	<	bUnique := False;
1490	<	end;
1485	>	FUniqueRelationName := strpas(relname)
1486	>	else
1487	>	if strpas(relname) <> FUniqueRelationName then
1488	>	begin
1489	>	FUniqueRelationName := '';
1490	>	bUnique := False;
1491	>	end;
1492		end;
1493	<	if NamesWereEmpty then begin
1494	<	st := String(aliasname);
1495	<	if st = '' then begin
1493	>	if NamesWereEmpty then
1494	>	begin
1495	>	st := strpas(aliasname);
1496	>	if st = '' then
1497	>	begin
1498		st := 'F_'; {do not localize}
1499		aliasname_length := 2;
1500		j := 1; j_len := 1;
1501		StrPCopy(aliasname, st + IntToStr(j));
1502	<	end else begin
1502	>	end
1503	>	else
1504	>	begin
1505		StrPCopy(aliasname, st);
1506		j := 0; j_len := 0;
1507		end;
1508	<	while GetXSQLVARByName(String(aliasname)) <> nil do begin
1508	>	while GetXSQLVARByName(strpas(aliasname)) <> nil do
1509	>	begin
1510		Inc(j); j_len := Length(IntToStr(j));
1511		if j_len + aliasname_length > 31 then
1512		StrPCopy(aliasname,
#	Line 1476 | Line 1516 | begin
1516		StrPCopy(aliasname, st + IntToStr(j));
1517		end;
1518		Inc(aliasname_length, j_len);
1519	<	AddName(String(aliasname), i);
1519	>	AddName(strpas(aliasname), i);
1520		end;
1521		case sqltype and (not 1) of
1522		SQL_TEXT, SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP,
#	Line 1532 | Line 1572 | begin
1572		FXSQLVARs[i] := TIBXSQLVAR.Create(self, FSQL);
1573		FXSQLVARs[i].FXSQLVAR := p;
1574		p := Pointer(PChar(p) + sizeof(FXSQLDA^.sqlvar));
1535	–	//        FNames.Add('');
1575		end;
1576		FSize := FCount;
1577		end;
#	Line 1548 | Line 1587 | end;
1587
1588		destructor TIBOutputDelimitedFile.Destroy;
1589		begin
1590	+	{$IFDEF LINUX}
1591	+	if FHandle <> -1 then
1592	+	fpclose(FHandle);
1593	+	{$ELSE}
1594		if FHandle <> 0 then
1595		begin
1596		FlushFileBuffers(FHandle);
1597		CloseHandle(FHandle);
1598		end;
1599	+	{$ENDIF}
1600		inherited Destroy;
1601		end;
1602
1603		procedure TIBOutputDelimitedFile.ReadyFile;
1604		var
1605		i: Integer;
1606	+	{$IFDEF LINUX}
1607	+	BytesWritten: cint;
1608	+	{$ELSE}
1609		BytesWritten: DWORD;
1610	+	{$ENDIF}
1611		st: string;
1612		begin
1613		if FColDelimiter = '' then
1614		FColDelimiter := TAB;
1615		if FRowDelimiter = '' then
1616		FRowDelimiter := CRLF;
1617	+	{$IFDEF LINUX}
1618	+	FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1619	+	{$ELSE}
1620		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
1621		FILE_ATTRIBUTE_NORMAL, 0);
1622		if FHandle = INVALID_HANDLE_VALUE then
1623		FHandle := 0;
1624	+	{$ENDIF}
1625		if FOutputTitles then
1626		begin
1627		for i := 0 to Columns.Count - 1 do
1628		if i = 0 then
1629	<	st := string(Columns[i].Data^.aliasname)
1629	>	st := strpas(Columns[i].Data^.aliasname)
1630		else
1631	<	st := st + FColDelimiter + string(Columns[i].Data^.aliasname);
1631	>	st := st + FColDelimiter + strpas(Columns[i].Data^.aliasname);
1632		st := st + FRowDelimiter;
1633	<	WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1633	>	{$IFDEF LINUX}
1634	>	if FHandle <> -1 then
1635	>	BytesWritten := FpWrite(FHandle,st[1],Length(st));
1636	>	if BytesWritten = -1 then
1637	>	raise Exception.Create('File Write Error');
1638	>	{$ELSE}
1639	>	WriteFile(FHandle, PChar(st[1]), Length(st), BytesWritten, nil);
1640	>	{$ENDIF}
1641		end;
1642		end;
1643
1644		function TIBOutputDelimitedFile.WriteColumns: Boolean;
1645		var
1646		i: Integer;
1647	+	{$IFDEF LINUX}
1648	+	BytesWritten: cint;
1649	+	{$ELSE}
1650		BytesWritten: DWORD;
1651	+	{$ENDIF}
1652		st: string;
1653		begin
1654		result := False;
1655	+	{$IFDEF LINUX}
1656	+	if FHandle <> -1 then
1657	+	{$ELSE}
1658		if FHandle <> 0 then
1659	+	{$ENDIF}
1660		begin
1661		st := '';
1662		for i := 0 to Columns.Count - 1 do
#	Line 1599 | Line 1666 | begin
1666		st := st + StripString(Columns[i].AsString, FColDelimiter + FRowDelimiter);
1667		end;
1668		st := st + FRowDelimiter;
1669	+	{$IFDEF LINUX}
1670	+	BytesWritten := FpWrite(FHandle,st[1],Length(st));
1671	+	{$ELSE}
1672		WriteFile(FHandle, st[1], Length(st), BytesWritten, nil);
1673	+	{$ENDIF}
1674		if BytesWritten = DWORD(Length(st)) then
1675		result := True;
1676		end
#	Line 1712 | Line 1783 | end;
1783		{ TIBOutputRawFile }
1784		destructor TIBOutputRawFile.Destroy;
1785		begin
1786	+	{$IFDEF LINUX}
1787	+	if FHandle <> -1 then
1788	+	fpclose(FHandle);
1789	+	{$ELSE}
1790		if FHandle <> 0 then
1791		begin
1792		FlushFileBuffers(FHandle);
1793		CloseHandle(FHandle);
1794		end;
1795	+	{$ENDIF}
1796		inherited Destroy;
1797		end;
1798
1799		procedure TIBOutputRawFile.ReadyFile;
1800		begin
1801	+	{$IFDEF LINUX}
1802	+	FHandle := FpOpen(Filename,O_WrOnly or O_Creat);
1803	+	{$ELSE}
1804		FHandle := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
1805		FILE_ATTRIBUTE_NORMAL, 0);
1806		if FHandle = INVALID_HANDLE_VALUE then
1807		FHandle := 0;
1808	+	{$ENDIF}
1809		end;
1810
1811		function TIBOutputRawFile.WriteColumns: Boolean;
#	Line 1738 | Line 1818 | begin
1818		begin
1819		for i := 0 to Columns.Count - 1 do
1820		begin
1821	+	{$IFDEF LINUX}
1822	+	BytesWritten := FpWrite(FHandle,Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen);
1823	+	{$ELSE}
1824		WriteFile(FHandle, Columns[i].Data^.sqldata^, Columns[i].Data^.sqllen,
1825		BytesWritten, nil);
1826	+	{$ENDIF}
1827		if BytesWritten <> DWORD(Columns[i].Data^.sqllen) then
1828		exit;
1829		end;
#	Line 1750 | Line 1834 | end;
1834		{ TIBInputRawFile }
1835		destructor TIBInputRawFile.Destroy;
1836		begin
1837	+	{$IFDEF LINUX}
1838	+	if FHandle <> -1 then
1839	+	fpclose(FHandle);
1840	+	{$ELSE}
1841		if FHandle <> 0 then
1842		CloseHandle(FHandle);
1843	<	inherited;
1843	>	{$ENDIF}
1844	>	inherited Destroy;
1845		end;
1846
1847		function TIBInputRawFile.ReadParameters: Boolean;
#	Line 1761 | Line 1850 | var
1850		BytesRead: DWord;
1851		begin
1852		result := False;
1853	+	{$IFDEF LINUX}
1854	+	if FHandle <> -1 then
1855	+	{$ELSE}
1856		if FHandle <> 0 then
1857	+	{$ENDIF}
1858		begin
1859		for i := 0 to Params.Count - 1 do
1860		begin
1861	<	ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen,
1861	>	{$IFDEF LINUX}
1862	>	BytesRead := FpRead(FHandle,Params[i].Data^.sqldata^,Params[i].Data^.sqllen);
1863	>	{$ELSE}
1864	>	ReadFile(FHandle, Params[i].Data^.sqldata^, Params[i].Data^.sqllen);
1865		BytesRead, nil);
1866	+	{$ENDIF}
1867		if BytesRead <> DWORD(Params[i].Data^.sqllen) then
1868		exit;
1869		end;
#	Line 1776 | Line 1873 | end;
1873
1874		procedure TIBInputRawFile.ReadyFile;
1875		begin
1876	+	{$IFDEF LINUX}
1877	+	if FHandle <> -1 then
1878	+	fpclose(FHandle);
1879	+	FHandle := FpOpen(Filename,O_RdOnly);
1880	+	if FHandle = -1 then
1881	+	raise Exception.CreateFmt('Unable to open file %s',[Filename]);
1882	+	{$ELSE}
1883		if FHandle <> 0 then
1884		CloseHandle(FHandle);
1885		FHandle := CreateFile(PChar(Filename), GENERIC_READ, 0, nil, OPEN_EXISTING,
1886		FILE_FLAG_SEQUENTIAL_SCAN, 0);
1887		if FHandle = INVALID_HANDLE_VALUE then
1888		FHandle := 0;
1889	+	{$ENDIF}
1890		end;
1891
1892		{ TIBSQL }
#	Line 1830 | Line 1935 | begin
1935		FSQLParams.Free;
1936		FSQLRecord.Free;
1937		end;
1938	<	inherited;
1938	>	inherited Destroy;
1939		end;
1940
1941		procedure TIBSQL.BatchInput(InputObject: TIBBatchInput);
#	Line 1982 | Line 2087 | begin
2087		Database.SQLDialect,
2088		FSQLParams.AsXSQLDA), True)
2089		end;
2090	+	{$IFDEF HAS_SQLMONITOR}
2091		if not (csDesigning in ComponentState) then
2092		MonitorHook.SQLExecute(Self);
2093	+	{$ENDIF}
2094		end;
2095
2096		function TIBSQL.GetEOF: Boolean;
#	Line 2001 | Line 2108 | begin
2108		result := GetFields(i);
2109		end;
2110
2111	+	function TIBSQL.ParamByName(ParamName: String): TIBXSQLVAR;
2112	+	begin
2113	+	Result := Params.ByName(ParamName);
2114	+	end;
2115	+
2116		function TIBSQL.GetFields(const Idx: Integer): TIBXSQLVAR;
2117		begin
2118		if (Idx < 0) or (Idx >= FSQLRecord.Count) then
#	Line 2040 | Line 2152 | begin
2152		FBOF := False;
2153		result := FSQLRecord;
2154		end;
2155	+	{$IFDEF HAS_SQLMONITOR}
2156		if not (csDesigning in ComponentState) then
2157		MonitorHook.SQLFetch(Self);
2158	+	{$ENDIF}
2159		end;
2160		end;
2161
#	Line 2372 | Line 2486 | begin
2486		end;
2487		end;
2488		FPrepared := True;
2489	+	{$IFDEF HAS_SQLMONITOR}
2490		if not (csDesigning in ComponentState) then
2491		MonitorHook.SQLPrepare(Self);
2492	+	{$ENDIF}
2493		except
2494		on E: Exception do begin
2495		if (FHandle <> nil) then

Diff Legend

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