
Vitaly Nevzorov
   
Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago
Репутация: 14 Всего: 207
|
Какой тип поля Data? Очень странно всё это, пример абсолютно рабочий... Вот моя программа, которая эмулирует файловую систему (дерево каталогов) на MS SQL Server 2000 и позволяет читать и писать файлы: | Код | unit uVirtFile;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, DB, ADODB, StdCtrls, Buttons, ImgList, ShellCtrls, ExtCtrls;
type TForm1 = class(TForm) ADOConnection: TADOConnection; q: TADOQuery; StatusBar: TStatusBar; SaveDialog: TSaveDialog; OpenDialog: TOpenDialog; Panel1: TPanel; SpeedButton4: TSpeedButton; SpeedButton3: TSpeedButton; SpeedButton5: TSpeedButton; SpeedButton6: TSpeedButton; SpeedButton7: TSpeedButton; SpeedButton8: TSpeedButton; Panel2: TPanel; Panel3: TPanel; ListBox: TListBox; Panel4: TPanel; Edit1: TEdit; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; Panel5: TPanel; ShellTreeView1: TShellTreeView; ShellListView1: TShellListView; SpeedButton9: TSpeedButton; ComboBox: TComboBox; SpeedButton10: TSpeedButton; procedure Button1Click(Sender: TObject); procedure ListBoxDblClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure SpeedButton4Click(Sender: TObject); procedure SpeedButton5Click(Sender: TObject); procedure SpeedButton6Click(Sender: TObject); procedure ListBoxClick(Sender: TObject); procedure SpeedButton7Click(Sender: TObject); procedure SpeedButton8Click(Sender: TObject); procedure ListBoxDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ListBoxDragDrop(Sender, Source: TObject; X, Y: Integer); procedure ShellListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure ShellListView1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure SpeedButton9Click(Sender: TObject); procedure SpeedButton10Click(Sender: TObject); private function v_AddDir(Parent: integer; Name: string): integer; procedure v_Dir(Id: integer; List: TStrings); function v_SaveFile(Parent: integer; Name: string): integer; procedure v_LoadFile(id: integer; Name: string); function v_GetParent(Id: integer): integer; function v_GetPath(id: integer): string; function v_GetFolderId: integer; procedure v_Delete(id: integer); procedure v_RenameFile(id: integer; NewName: string); procedure RestorePosition(i: integer); function FindById(Id: Integer): integer; { Private declarations } public { Public declarations } end;
Type TFileInfo=record Id:integer; Parent:integer; Level:integer; ItemType:integer; ItemSize:integer; ItemName:string[255]; End; PFileInfo=^TFileInfo;
var Form1: TForm1;
implementation
{$R *.dfm}
Function TForm1.v_GetPath(id:integer):string; var parent:integer; begin Parent:=id; Result:=''; q.sql.clear; q.sql.add('Select Parent, ItemName From fs Where ItemId=:ItemId'); q.Parameters.ParseSQL(q.sql.text, true); while Parent>=0 do begin q.Parameters.ParamByName('ItemId').Value:=Parent; q.open; if Result<>'' then Result:=q.FieldByName('ItemName').asString+'/'+Result else Result:=q.FieldByName('ItemName').asString; Parent:=q.FieldByName('Parent').asInteger; q.close; end; Result:='/'+Result; end;
Function TForm1.v_AddDir(Parent:integer;Name:string):integer; begin q.sql.clear; q.sql.add('Declare @Parent int'); q.sql.add('Declare @ItemLevel int'); q.sql.add('Set @Parent=:Parent'); q.sql.add('if @Parent>=0 Select @ItemLevel=ItemLevel from fs where ItemId=@Parent'); q.sql.add(' else Set @ItemLevel=-1'); q.sql.add('Set @ItemLevel=@ItemLevel+1'); q.sql.add('INSERT INTO fs (Parent, ItemLevel, ItemType, ItemName)'); q.sql.add('VALUES(@Parent, @ItemLevel, 1, :ItemName)'); q.sql.add('Select @@Identity'); q.Parameters.ParseSQL(q.sql.text, true); q.Parameters.ParamByName('Parent').Value:=Parent; q.Parameters.ParamByName('ItemName').Value:=Name; q.ExecSQL; end;
Function TForm1.v_GetParent(Id:integer):integer; begin q.sql.clear; q.sql.add('Select Parent From fs Where ItemId=:ItemId'); q.Parameters.ParseSQL(q.sql.text, true); q.Parameters.ParamByName('ItemId').Value:=Id; q.open; Result:=q.fields[0].asInteger; q.close; end;
Procedure TForm1.v_Dir(Id:integer;List:TStrings); var Info:PFileInfo; begin List.clear; //FreeMem(PropList); q.sql.clear; q.sql.add('Select * From fs Where Parent=:Parent'); q.Parameters.ParseSQL(q.sql.text, true); q.Parameters.ParamByName('Parent').Value:=Id; q.Open; if q.fieldByName('Parent').asInteger<>-1 then begin GetMem(Info, SizeOf(TFileInfo)); Info^.Id:=Id; Info^.Parent:=0; Info^.Level:=q.fieldByName('ItemLevel').asInteger-1; Info^.ItemType:=0; Info^.ItemName:='..'; List.Objects[List.add('..')]:=Pointer(Info); end; while not q.eof do begin GetMem(Info, SizeOf(TFileInfo)); Info^.Id:=q.fieldByName('ItemId').asInteger; Info^.Parent:=q.fieldByName('Parent').asInteger; Info^.Level:=q.fieldByName('ItemLevel').asInteger; Info^.ItemType:=q.fieldByName('ItemType').asInteger; Info^.ItemName:=q.fieldByName('ItemName').asString; Info^.ItemSize:=q.fieldByName('ItemSize').asInteger; Case Info^.ItemType of 1:List.Objects[List.add('>'+q.fieldByName('ItemName').asString)]:=Pointer(Info); 2:List.Objects[List.add(q.fieldByName('ItemName').asString)]:=Pointer(Info); End; q.next; end; q.close; end;
Function TForm1.v_SaveFile(Parent:integer;Name:string):integer; Function GetFileSize(FileName:string):integer; var sr:TSearchRec; begin Result:=0; if FindFirst(FileName, faAnyFile, sr)=0 then Result:=sr.size; FindClose(sr); end;
begin q.sql.clear; q.sql.add('Declare @Parent int'); q.sql.add('Declare @ItemLevel int'); q.sql.add('Set @Parent=:Parent'); q.sql.add('if @Parent>=0 Select @ItemLevel=ItemLevel from fs where ItemId=@Parent'); q.sql.add(' else Set @ItemLevel=-1'); q.sql.add('Set @ItemLevel=@ItemLevel+1'); q.sql.add('INSERT INTO fs (Parent, ItemLevel, ItemType, ItemName, ItemSize, Data)'); q.sql.add('VALUES(@Parent, @ItemLevel, 2, :ItemName, :ItemSize, :Data)'); q.sql.add('Select @@Identity'); q.Parameters.ParseSQL(q.sql.text, true); q.Parameters.ParamByName('Parent').Value:=Parent; q.Parameters.ParamByName('ItemName').Value:=ExtractFileName(Name); q.Parameters.ParamByName('ItemSize').Value:=GetFileSize(Name); q.Parameters.ParamByName('Data').LoadFromFile(Name, ftGraphic); q.Open; result:=q.Fields[0].AsInteger; q.Close; end;
Procedure TForm1.v_LoadFile(id:integer;Name:string); begin q.sql.clear; q.sql.add('Select Data from fs where ItemId=:id'); q.Parameters.ParseSQL(q.sql.text, true); q.Parameters.ParamByName('id').Value:=id; q.Open; (q.fields[0] as TBlobField).SaveToFile(Name); q.Close; end;
Procedure TForm1.v_RenameFile(id:integer;NewName:string); begin q.sql.clear; q.sql.add('Update fs Set ItemName=:ItemName where ItemId=:id'); q.Parameters.ParseSQL(q.sql.text, true); q.Parameters.ParamByName('id').Value:=id; q.Parameters.ParamByName('ItemName').Value:=NewName; q.ExecSQL; end;
Procedure TForm1.v_Delete(id:integer); begin q.sql.clear; q.sql.add('Delete from fs where ItemId=:id'); q.sql.add('while (Select count(*) From fs where Parent not in (Select Distinct ItemId From fs) and Parent<>-1)>0 begin Delete from fs where Parent not in (Select Distinct ItemId From fs) and Parent<>-1 end'); q.Parameters.ParseSQL(q.sql.text, true); q.Parameters.ParamByName('id').Value:=id; q.execSQL; end;
Function TForm1.v_GetFolderId:integer; begin if ListBox.Items.Count=0 then begin result:=-1; exit; end; if PFileInfo(ListBox.items.Objects[0])^.ItemName<>'..' then Result:=PFileInfo(ListBox.items.Objects[0])^.Parent else Result:=PFileInfo(ListBox.items.Objects[0])^.Id; end;
procedure TForm1.Button1Click(Sender: TObject); begin Showmessage(v_GetPath(3)); // v_SaveFile(1, 'c:\boot.ini'); // v_LoadFile(3, 'c:\qqqqqqqqqq'); end;
procedure TForm1.ListBoxDblClick(Sender: TObject); var i:integer; begin
Case PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemType of 0: begin i:=PFileInfo(ListBox.items.Objects[0])^.Id; v_Dir(v_GetParent(PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.Id), ListBox.items); RestorePosition(FindById(i)); end; 1: v_Dir(PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.Id, ListBox.items); 2: SpeedButton5Click(nil); end; StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId); end;
procedure TForm1.FormActivate(Sender: TObject); begin onActivate:=nil; end;
function TForm1.FindById(Id:Integer):integer; var i:integer; begin Result:=0; for i:=0 to ListBox.Items.Count-1 do begin if PFileInfo(ListBox.items.Objects[i])^.Id=Id then begin Result:=i; exit; end; end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject); var i:integer; begin i:=PFileInfo(ListBox.items.Objects[0])^.Id; v_Dir(v_GetParent(PFileInfo(ListBox.items.Objects[0])^.Id), ListBox.items); StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId); RestorePosition(FindById(i)); end;
procedure TForm1.SpeedButton2Click(Sender: TObject); begin v_Dir(-1, ListBox.items); StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId); RestorePosition(0); end;
procedure TForm1.SpeedButton3Click(Sender: TObject); var s:string; var i:integer; begin i:=ListBox.ItemIndex; if InputQuery('New Folder','',s) then i:=v_AddDir(v_GetFolderId, s); v_Dir(v_GetFolderId, ListBox.items); StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId); RestorePosition(i); end;
procedure TForm1.RestorePosition(i:integer); begin ListBox.ItemIndex:=i; if ListBox.ItemIndex=-1 then ListBox.ItemIndex:=0; ListBoxClick(nil); end;
procedure TForm1.SpeedButton4Click(Sender: TObject); var i:integer; begin i:=ListBox.ItemIndex; if ListBox.ItemIndex<0 then exit; if (ListBox.ItemIndex=0) and (ListBox.Items[ListBox.ItemIndex]='..') then exit; v_Delete(PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.Id); v_Dir(v_GetFolderId, ListBox.items); StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId); RestorePosition(i); end;
procedure TForm1.SpeedButton5Click(Sender: TObject); var i:integer; begin if ListBox.ItemIndex=-1 then exit; i:=ListBox.ItemIndex; if PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemType<>2 then exit; SaveDialog.FileName:=PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemName; if SaveDialog.Execute then v_LoadFile(PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.Id, SaveDialog.FileName); RestorePosition(i); end;
procedure TForm1.SpeedButton6Click(Sender: TObject); var i:integer; begin i:=ListBox.ItemIndex; if OpenDialog.Execute then i:=v_SaveFile(v_GetFolderId, OpenDialog.FileName); v_Dir(v_GetFolderId, ListBox.items); StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId); RestorePosition(FindById(i)); end;
procedure TForm1.ListBoxClick(Sender: TObject); var i:integer; begin if ListBox.ItemIndex=-1 then exit; Case PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemType of 0: StatusBar.Panels[0].Text:='Up'; 1: StatusBar.Panels[0].Text:='Dir'; 2: StatusBar.Panels[0].Text:='File'; End; Case PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemType of 2: begin i:=PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemSize; if i<1024 then StatusBar.Panels[1].Text:=Format('%d Bytes', [i]) else if i<1024*1024 then StatusBar.Panels[1].Text:=Format('%f Kb', [i/1024]) else StatusBar.Panels[1].Text:=Format('%f Mb', [i/(1024*1024)]); end; else StatusBar.Panels[1].Text:=''; End; end;
procedure TForm1.SpeedButton7Click(Sender: TObject); var s:string; var i:integer; begin if ListBox.ItemIndex=-1 then exit; i:=ListBox.ItemIndex; Case PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemType of 2: begin if InputQuery('Rename file '+PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemName,'Enter new name',s) then v_RenameFile(PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.Id, s); end; 1: begin if InputQuery('Rename folder '+PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemName,'Enter new name',s) then v_RenameFile(PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.Id, s); end; else exit; End; v_Dir(v_GetFolderId, ListBox.items); StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId); RestorePosition(i); end;
procedure TForm1.SpeedButton8Click(Sender: TObject); var i:integer; begin i:=ListBox.ItemIndex; v_Dir(v_GetFolderId, ListBox.items); StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId); ListBoxClick(nil); RestorePosition(i); end;
procedure TForm1.ListBoxDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept:=Source is TShellListView; end;
procedure TForm1.ListBoxDragDrop(Sender, Source: TObject; X, Y: Integer); var i:integer; begin i:=ListBox.ItemIndex; try i:=v_SaveFile(v_GetFolderId,ShellTreeView1.Path+'\'+TShellListView(Source).SelectedFolder.DisplayName); finally v_Dir(v_GetFolderId, ListBox.items); StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId); RestorePosition(FindById(i)); end; end;
procedure TForm1.ShellListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept:=Source is TListBox; end;
procedure TForm1.ShellListView1DragDrop(Sender, Source: TObject; X, Y: Integer); var i:integer; FileName:string; begin if ListBox.ItemIndex=-1 then exit; i:=ListBox.ItemIndex; if PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemType<>2 then exit; FileName:=ShellTreeView1.Path+'\'+PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.ItemName; v_LoadFile(PFileInfo(ListBox.items.Objects[ListBox.ItemIndex])^.Id, FileName); RestorePosition(i); end;
procedure TForm1.SpeedButton9Click(Sender: TObject); begin ADOConnection.Connected:=false; ADOConnection.ConnectionString:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source='+Edit1.Text; q.SQL.text:='Select Name from sysdatabases order by 1'; q.Open; ComboBox.Items.Clear; while not q.Eof do begin ComboBox.Items.Add(q.Fields[0].asstring); q.Next; end; q.Close; end;
procedure TForm1.SpeedButton10Click(Sender: TObject); begin ADOConnection.Connected:=false; ADOConnection.ConnectionString:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog='+ComboBox.Items[ComboBox.itemindex]+';Data Source='+Edit1.Text; ADOConnection.Connected:=true; q.sql.Text:='if (select count(*) From sysobjects where name=''fs'' and xtype=''U'')=0'; q.sql.add('begin CREATE TABLE [dbo].[fs] ('); q.sql.add('[ItemId] [int] IDENTITY (1, 1) NOT NULL ,'); q.sql.add('[Parent] [int] NOT NULL ,'); q.sql.add('[ItemLevel] [int] NOT NULL ,'); q.sql.add('[ItemType] [int] NOT NULL ,'); q.sql.add('[ItemSize] [bigint] NULL ,'); q.sql.add('[ItemName] [varchar] (255) NULL ,'); q.sql.add('[Data] [image] NULL'); q.sql.add(') ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]'); q.sql.add('ALTER TABLE [dbo].[fs] WITH NOCHECK ADD'); q.sql.add(' CONSTRAINT [DF_fs_ItemType] DEFAULT (1) FOR [ItemType],'); q.sql.add(' CONSTRAINT [PK_fs] PRIMARY KEY CLUSTERED'); q.sql.add(' ('); q.sql.add(' [ItemId]'); q.sql.add(' ) ON [PRIMARY] end'); q.ExecSQL;
v_Dir(-1, ListBox.items); StatusBar.Panels[2].Text:=v_GetPath(v_GetFolderId);
end;
end.
|
--------------------
With the best wishes, VitI have done so much with so little for so long that I am now qualified to do anything with nothing Самый большой Delphi FAQ на русском языке здесь: www.drkb.ru
|