Новые потоки в Delphi более разносторонние, чем в BP7. Поскольку вы знаете как пользоваться потоками в BP7, а размер статьи ограничен, то я думаю, что для начала вам необходимо попробовать в действии описанный ниже модуль, инкапсулирующий класс для работы с потоками в стиле BP7. Класс является наследником TComponent, но в нашем случае не было бы никакой разницы, если бы он был наследником TObject. К примеру, вы могли бы адаптировать данный код к своему наследнику TList.
Более важен тот факт, что вы можете использовать поток так, как вам это необходимо, исходя из вашей задачи и специфики. Я сделал работу потока похожую по стилю на BP7, где вначале идет ID класса. В каком-нибудь месте вам необходимо вызвать RegisterType( TYourClass, UniqueIDLikeBP7 ), после чего TYourClass готов к работе с потоками.
Вы наверняка обратили внимание, что я реализовал список зарегистрированных классов (регистратор), где с помощью ID легко можно найти классы, читающие и пишущие в поток в момент вызова конструктора Load соответствующего класса. Код простой и не требующий пояснений. Имейте в виду, что данный код можно использовать для организации передачи данных между существующим файловым потоком BP7 в объекты Delphi - я создал это для осуществления миграции с текущего приложения BP7 в Delphi и осуществления совместимости.
Если вам необходима более подробная информацио о работе потоков в Delphi, обратитесь к соответствующему разделу электронной справки Delphi.
Успехов.
Mike Scott.
unit CompStrm; interface uses Classes ; typeTCompatibleStream = class ; { TStreamObject } TStreamObject = class( TComponent )constructor Load( S : TCompatibleStream ) ; virtual ; abstract ;procedure Store( S : TCompatibleStream ) ; virtual ; abstract ;function GetObjectType : word ; virtual ; abstract ;end ; TStreamObjectClass = class of TStreamObject ; { TCompatibleStream } TCompatibleStream = class( TFileStream )function ReadString : string ;procedure WriteString( var S : string ) ;function StrRead : PChar ;procedure StrWrite( P : PChar ) ;function Get : TStreamObject ; virtual ;procedure Put( AnObject : TStreamObject ) ; virtual ;end ; { Register Type : используйте это для регистрации ваших объектов дляработы с потоками с тем же ID, который они имели в OWL } procedure RegisterType( AClass : TStreamObjectClass ;AnID : word ) ; implementation uses SysUtils, Controls ; var Registry : TList ; { хранение ID объекта и информации о классе } { TClassInfo } typeTClassInfo = class( TObject )ClassType : TStreamObjectClass ;ClassID : word ;constructor Create( AClassType : TStreamObjectClass ;AClassID : word ) ; virtual ;end ; constructor TClassInfo.Create( AClassType : TStreamObjectClass ;AClassID : word ) ; var AnObject : TStreamObject ; beginif not Assigned( AClassType ) thenRaise EInvalidOperation.Create( 'Класс не инициализирован') ; if not AClassType.InheritsFrom( TStreamObject ) thenRaise EInvalidOperation.Create( 'Класс ' + AClassType.ClassName +' не является потомком TStreamObject') ; ClassType := AClassType ;ClassID := AClassID ;end ; { функции поиска информации о классе } function FindClassInfo( AClass : TClass ) : TClassInfo ; var i : integer ; beginfor i := Registry.Count - 1 downto 0 do beginResult := TClassInfo( Registry.Items[ i ] ) ;if Result.ClassType = AClass then exit ;end ;Raise EInvalidOperation.Create( 'Класс ' + AClass.ClassName +' не зарегистрирован для работы с потоком' ) ;end ; function FindClassInfoByID( AClassID : word ) : TClassInfo ; var i : integer ;AName : string[ 31 ] ; beginfor i := Registry.Count - 1 downto 0 do beginResult := TClassInfo( Registry.Items[ i ] ) ;AName := TClassInfo( Registry.Items[ i ] ).ClassType.ClassName ;if Result.ClassID = AClassID then exit ;end ;Raise EInvalidOperation.Create( 'ID класса ' + IntToStr( AClassID ) +' отсутствует в регистратореклассов' ) ; end ; procedure RegisterType( AClass : TStreamObjectClass ;AnID : word ) ; var i : integer ; begin{ смотрим, был ли класс уже зарегистрирован }for i := Registry.Count - 1 downto 0 dowith TClassInfo( Registry[ i ] ) do if ClassType = AClass thenbeginif ClassID <> AnID thenRaise EInvalidOperation.Create( 'Класс ' + AClass.ClassName +' уже зарегистрирован с ID ' +IntToStr( ClassID ) ) ;exit ;end ;Registry.Add( TClassInfo.Create( AClass, AnID ) ) ;end ; { TCompatibleStream } function TCompatibleStream.ReadString : string ; beginReadBuffer( Result[ 0 ], 1 ) ;if byte( Result[ 0 ] ) > 0 then ReadBuffer( Result[ 1 ], byte( Result[ 0] ) ) ; end ; procedure TCompatibleStream.WriteString( var S : string ) ; beginWriteBuffer( S[ 0 ], 1 ) ;if Length( S ) > 0 then WriteBuffer( S[ 1 ], Length( S ) ) ;end ; function TCompatibleStream.StrRead : PChar ; var L : Word ;P : PChar ; beginReadBuffer( L, SizeOf( Word ) ) ;if L = 0 then StrRead := nil elsebeginP := StrAlloc( L + 1 ) ;ReadBuffer( P[ 0 ], L ) ;P[ L ] := #0 ;StrRead := P ;end ;end ; procedure TCompatibleStream.StrWrite( P : PChar ) ; var L : Word ; beginif P = nil then L := 0 else L := StrLen( P ) ;WriteBuffer( L, SizeOf( Word ) ) ;if L > 0 then WriteBuffer( P[ 0 ], L ) ;end; function TCompatibleStream.Get : TStreamObject ; var AClassID : word ; begin{ читаем ID объекта, находим это в регистраторе и загружаем объект }ReadBuffer( AClassID, sizeof( AClassID ) ) ;Result := FindClassInfoByID( AClassID ).ClassType.Load( Self ) ;end ; procedure TCompatibleStream.Put( AnObject : TStreamObject ) ; var AClassInfo : TClassInfo ;ANotedPosition : longint ;DoTruncate : boolean ; begin{ получает объект из регистратора }AClassInfo := FindClassInfo( AnObject.ClassType ) ; { запоминаем позицию в случае проблемы }ANotedPosition := Position ;try{ пишем id класса и вызываем метод store }WriteBuffer( AClassInfo.ClassID, sizeof( AClassInfo.ClassID ) ) ;AnObject.Store( Self ) ;except{ откатываемся в предыдущую позицию и, если EOF, тогда truncate }DoTruncate := Position = Size ;Position := ANotedPosition ;if DoTruncate then Write( ANotedPosition, 0 ) ;Raise ;end ;end ; { выход из обработки, очистка регистратора } procedure DoneCompStrm ; far ; var i : integer ; begin{ освобождаем регистратор }for i := Registry.Count - 1 downto 0 do TObject( Registry.Items[ i ]).Free ; Registry.Free ;end ; beginRegistry := TList.Create ;AddExitProc( DoneCompStrm ) ;end. |
[000613]