/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 911
от 31.08.2007, 20:35

Вопрос № 99.721

Здравствуйте Уважаемые!У меня к Вам вот какой вопрос.Я должен из бинарного файла ридом считывать блочки по 3 байт во временную переменую temp,правильно ли я сделал выбрав её тип как Cardinal(т.е 4-х байтовый),а если правильно расскажите как по байтно (от начала или от конца)считается туда этот блочок,если допустим если смотреть в шестнацетиричном редакторе там идёт 00 00 10(как запишется это в 4 байта).

Отправлен: 26.08.2007, 15:33 Вопрос задал: Зотов Геннадий Александрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 7)

Отвечает: Coupler Здравствуйте, Зотов Геннадий Александрович! Допустим, имеется бинарный файл с содержимым 02 03 04 05 06 07 08 09. Чтобы считать 3 байта, можно использовать процедуру BlockRead(var F: File; var Buf; Count: Integer [var AmtTransferred: Integer]). Переменная типа cardinal занимает 4 байта в памяти, и нетрудно посмотреть, что 3 байта "встанут" на старшие адреса (поставьте breakpoint и посмотрите на temp как на дамп памяти) - она будет иметь вид $02 $03 $04 $00. Также можно читать 3 байта в массив array [1..3] of byte - там байты будут по порядку, как в файле. Примеры чтения в приложении. Приложение: procedure TForm1.Button1Click(Sender: TObject); var f: file; temp1:cardinal; begin AssignFile(f, 'file.bin'); Reset(f,1); BlockRead(f, temp1, 3); CloseFile(f); end; procedure TForm1.Button2Click(Sender: TObject); var f: file; buf: array [1..3] of byte; i:byte; begin AssignFile(f, 'file.bin'); Reset(f,1); BlockRead(f, buf, sizeof(buf)); CloseFile(f); for i:=1 to 3 do //байты в массиве showmessage (inttostr (buf[i])); end;

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 26.08.2007, 16:38 Оценка за ответ: 5 Комментарий оценки: спасибо за подробный ответ с примерами

Вопрос № 99.739

Здравсвуйте! Скажите, пожалуйста, как можно в заданной папке с несколькими подпапками найти все mp3 файлы, и добавить их в TreeView. И можно как-нибудь прочесть инфу из тегов -исполнитель и альбом и сортировать их уже по этим полям(плюс и название трека взять оттуда же)? Может быть для этого нужны какие-нибудь компоненты(JVCL уже есть)? Спасибо! Приложение: То есть выглядеть оно должно вот так: +Исполнитель +Альбом -трек1 -трек2 -трек3 +Альбом -трек1 -трек2 -трек3 +Исполнитель +Альбом -трек1 -трек2 -трек3

Отправлен: 26.08.2007, 19:09 Вопрос задал: Skvitek (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Уваров Андрей Александрович Здравствуйте, Skvitek! Вопрос 1: Смотрите пример кода. Вытащите все что вам нужно оттуда. Код рабочий - я из своей программы вытянул. Это полностью юнит с кодом поиска и добавления файлов в потоке в список. Просто список! Без ID3 Тэгов. (Они так называются правильно) Frm_Main.MP3List это список. Frm_Main.E_Of это лейбл с колличеством файлов которые нашло. В приложении DFM файл с формой. Он использует TProgressCyl и Alcione компоненты. (Красивого вида) Их можно найти на Torry.net либо я могу вам их выслать по email. Вопрос 2: Есть такой компонент TID3Engine. Через него читаются и пишутся тэги. Тоже на torry.net он есть. Вот пример чтения тегов: procedure TFrm_ID3.LoadID3( FileName: string ); begin try ID3Engine := TID3Engine.Create( Frm_ID3 ); ID3Engine.FileName := FileName; ID3Engine.Active := True; L_Version.Caption := IntToStr( ID3Engine.Header.VersionNumber ) + '.' + IntToStr( ID3Engine.Header.VersionRevision ); with Frm_ID3 do with ID3Engine do begin E_Name.Text := Title; E_Artist.Text := Artist; E_Album.Text := Album; E_Genre.Text := Genre; E_Year.Text := Year; end; ID3Engine.Active := False; except MessageBox( handle, PChar( Format( 'Невозможно получить информацию и файле %s!', [ FileName ] ) ), 'Ошибка ID3!', MB_ICONERROR + MB_OK ); end; end; Сортировку уже делайте сами. Скажу только что в DelphiWorld есть много вариантов сортировки. Это уже на ваш вкус. ============================= Код юнита слишком большой, поэтому он перенесён в Приложение. Эксперт sir henry Приложение: {Код юнита:} unit u_add; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ToolWin, ComCtrls, StdCtrls, ExtCtrls, ALButton, ProgressCyl; type TFrm_Add = class( TForm ) Pan_Title: TPanel; Btn_Close: TShape; L_Close: TLabel; Btn_Minimize: TShape; L_Minimize: TLabel; L_Caption: TLabel; ToolBar: TToolBar; Pan_Main: TPanel; Btn_Cancel: TALButton; Progress: TProgressCyl; L_Progress: TLabel; L_Status: TLabel; procedure Btn_CancelClick( Sender: TObject ); procedure Btn_CancelPaint( Sender: TObject; var continue: Boolean ); procedure Pan_TitleMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); procedure Btn_MinimizeMouseLeave( Sender: TObject ); procedure Btn_MinimizeMouseEnter( Sender: TObject ); procedure Btn_CloseMouseUp( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); procedure Btn_MinimizeMouseUp( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); procedure Btn_CloseMouseLeave( Sender: TObject ); procedure Btn_CloseMouseEnter( Sender: TObject ); private { Private declarations } public procedure AddDir( Dir: string ); { Public declarations } end; var hCThId: THandle; hAThId: THandle; hALThId: THandle; CThId: Cardinal; AThId: Cardinal; ALThId: Cardinal; Frm_Add: TFrm_Add; aFilesCount: Integer = 0; aDir: string = ''; aFilePath: string = ''; aFinished: boolean = false; function GetFilesCount( Dir: string ): integer; function GetDirs( Dir: string ): integer; function FilesCount( Parametr: Pointer ): Integer; function FilesAdd( Parametr: Pointer ): Integer; procedure SearchDirs( Dir: string ); procedure SearchFiles( Dir: string ); procedure AddToList( ); function FilesAddList( Parametr: Pointer ): Integer; implementation uses u_main, u_skin; {$R *.dfm} procedure AddToList( ); begin MP3s.Add( aFilePath ); Frm_Add.L_Status.Caption := aFilePath; Frm_Add.Progress.AddProgress; end; function GetFilesCount( Dir: string ): integer; var fs: TSearchRec; begin Result := 0; if FindFirst( Dir + '*', faAnyFile, fs ) = 0 then repeat if ( fs.Name <> '.' ) and ( fs.Name <> '..' ) and ( lowercase( ExtractFileExt( fs.Name ) ) = '.mp3' ) and ( FileExists( Dir + '' + fs.Name ) ) then Inc( Result ); until FindNext( fs ) <> 0; FindClose( fs ); Result := Result + GetDirs( Dir ); end; function GetDirs( Dir: string ): integer; var fs: TSearchRec; begin Result := 0; if FindFirst( Dir + '*', faDirectory, fs ) = 0 then repeat if ( fs.Name <> '.' ) and ( fs.Name <> '..' ) and ( DirectoryExists( Dir + '' + fs.Name ) ) then Result := Result + GetFilesCount( Dir + '' + fs.Name ); until FindNext( fs ) <> 0; FindClose( fs ); end; procedure SearchFiles( Dir: string ); var fs: TSearchRec; begin if FindFirst( Dir + '*', faAnyFile, fs ) = 0 then repeat if ( fs.Name <> '.' ) and ( fs.Name <> '..' ) and ( lowercase( ExtractFileExt( fs.Name ) ) = '.mp3' ) and ( FileExists( Dir + '' + fs.Name ) ) then begin aFilePath := Dir + '' + fs.Name; AddToList; end; until FindNext( fs ) <> 0; FindClose( fs ); SearchDirs( Dir ); end; procedure SearchDirs( Dir: string ); var fs: TSearchRec; begin if FindFirst( Dir + '*', faDirectory, fs ) = 0 then repeat if ( fs.Name <> '.' ) and ( fs.Name <> '..' ) and ( DirectoryExists( Dir + '' + fs.Name ) ) then SearchFiles( Dir + '' + fs.Name ); until FindNext( fs ) <> 0; FindClose( fs ); end; function FilesCount( Parametr: Pointer ): Integer; begin aFilesCount := GetFilesCount( aDir ); // ROOT Folder SetEvent( hCThId ); end; function FilesAddList( Parametr: Pointer ): Integer; var I: Integer; begin Frm_Main.MP3List.Clear; for I := 0 to aFilesCount - 1 do begin Frm_Main.MP3List.Items.Add.Caption := ExtractFileName( MP3s.Strings[ I ] ); Frm_Add.Progress.AddProgress; Frm_Main.E_Of.Caption := IntToStr( Frm_Main.MP3List.Items.Count ); end; aFinished := True; // Post with Frm_Add do begin L_Status.Caption := 'Готово! Добавлено - ' + IntToStr( aFilesCount ) + ' .'; Btn_Cancel.Caption := 'Готово'; Btn_Cancel.GlyphIndex := 6; Btn_Cancel.Repaint; end; SetEvent( hALThId ); end; function FilesAdd( Parametr: Pointer ): Integer; begin SearchFiles( aDir ); SetEvent( hAThId ); end; procedure TFrm_Add.AddDir( Dir: string ); begin Frm_Add := TFrm_Add.Create( Self ); Frm_Add.FormStyle := fsStayOnTop; Frm_Add.Repaint; with Frm_Add do begin aDir := Dir; aFilesCount := 0; aFilePath := ''; aFinished := false; Progress.Position := 0; hCThId := CreateEvent( nil, FALSE, FALSE, nil ); hAThId := CreateEvent( nil, FALSE, FALSE, nil ); // 1 L_Status.Caption := '[1/3] Подождите, идет подсчет колличества файлов...'; Frm_Add.Repaint; BeginThread( nil, 0, @FilesCount, 0, 0, CThId ); WaitForSingleObject( hCThId, Infinite ); CloseHandle( hCThId ); // 2 Progress.Max := aFilesCount; Progress.Position := 0; L_Status.Caption := '[2/3] Подождите, идет добавление файлов...'; Frm_Add.Repaint; BeginThread( nil, 0, @FilesAdd, 0, 0, AThId ); WaitForSingleObject( hAThId, Infinite ); CloseHandle( hAThId ); // 3 Progress.Position := 0; L_Status.Caption := '[3/3] Подождите, идет добавление файлов в список...'; Frm_Add.Repaint; BeginThread( nil, 0, @FilesAddList, 0, 0, ALThId ); WaitForSingleObject( hALThId, Infinite ); CloseHandle( hALThId ); Frm_Main.E_Of.Caption := IntToStr( Frm_Main.MP3List.Items.Count ); end; end; procedure TFrm_Add.Btn_CancelClick( Sender: TObject ); begin if aFinished then Self.Close else if MessageBox( handle, 'Вы действительно хотите остановить процесс?', 'Отмена...', MB_YESNO + MB_ICONINFORMATION ) = MRYES then begin TerminateThread( CThId, 1 ); TerminateThread( AThId, 1 ); TerminateThread( ALThId, 1 ); Self.Close; end; end; procedure TFrm_Add.Btn_CancelPaint( Sender: TObject; var continue: Boolean ); begin PaintAlButtonSystemSkin( Sender, Continue ); end; procedure TFrm_Add.Btn_CloseMouseEnter( Sender: TObject ); begin Btn_Close.Brush.Color := clBtnHighlight; end; procedure TFrm_Add.Btn_CloseMouseLeave( Sender: TObject ); begin Btn_Close.Brush.Color := clBtnFace; end; procedure TFrm_Add.Btn_CloseMouseUp( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); begin if Button = mbLeft then begin Btn_Cancel.Click; end; end; procedure TFrm_Add.Btn_MinimizeMouseEnter( Sender: TObject ); begin Btn_Minimize.Brush.Color := clBtnHighlight; end; procedure TFrm_Add.Btn_MinimizeMouseLeave( Sender: TObject ); begin Btn_Minimize.Brush.Color := clBtnFace; end; procedure TFrm_Add.Btn_MinimizeMouseUp( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); begin if Button = mbLeft then AppChangeState; end; procedure TFrm_Add.Pan_TitleMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); const SC_DragMove = $F012; { a magic number } begin ReleaseCapture; perform( WM_SysCommand, SC_DragMove, 0 ); end; end. ========== DFM ========== object Frm_Add: TFrm_Add Left = 0 Top = 0 Borderstyle="bsNone" ClientHeight = 131 ClientWidth = 300 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.style="[]" OldCreateOrder = False Position = poMainFormCenter Visible = True PixelsPerInch = 96 TextHeight = 13 object Pan_Title: TPanel Left = 0 Top = 0 Width = 300 Height = 39 Align = alTop BevelEdges = [beLeft, beTop, beRight] BevelKind = bkFlat BevelOuter = bvNone TabOrder = 0 OnMouseDown = Pan_TitleMouseDown object Btn_Close: TShape Left = 264 Top = 1 Width = 32 Height = 14 Hint = #1054#1090#1084#1077#1085#1080#1090#1100' '#1076#1086#1073#1072#1074#1083#1077#1085#1080#1077' '#1092#1072#1081#1083#1086#1074 Brush.Color = clBtnFace ParentShowHint = False Pen.Color = clBtnShadow Shape = stRoundRect ShowHint = True OnMouseEnter = Btn_CloseMouseEnter OnMouseLeave = Btn_CloseMouseLeave OnMouseUp = Btn_CloseMouseUp end object L_Close: TLabel Left = 277 Top = 1 Width = 7 Height = 13 Hint = #1054#1090#1084#1077#1085#1080#1090#1100' '#1076#1086#1073#1072#1074#1083#1077#1085#1080#1077' '#1092#1072#1081#1083#1086#1074 Caption = 'X' Font.Charset = DEFAULT_CHARSET Font.Color = clBtnText Font.Height = -11 Font.Name = 'Tahoma' Font.style="[fsBold]" ParentFont = False ParentShowHint = False ShowHint = True Transparent = True OnMouseUp = Btn_CloseMouseUp OnMouseEnter = Btn_CloseMouseEnter OnMouseLeave = Btn_CloseMouseLeave end object Btn_Minimize: TShape Left = 246 Top = 1 Width = 17 Height = 14 Hint = #1057#1082#1088#1099#1090#1100' '#1087#1088#1086#1075#1088#1072#1084#1084#1091' '#1073#1077#1079' '#1086#1089#1090#1072#1085#1086#1074#1082#1080' '#1087#1088#1086#1094#1077#1089#1089#1072' '#1086#1073#1088#1072#1073#1086#1090#1082#1080' '#1092#1072#1081#1083#1086#1074'. ('#1045#1089#1083#1080' ' + #1085#1072#1095#1072#1090')' Brush.Color = clBtnFace ParentShowHint = False Pen.Color = clBtnShadow Shape = stRoundRect ShowHint = True OnMouseEnter = Btn_MinimizeMouseEnter OnMouseLeave = Btn_MinimizeMouseLeave OnMouseUp = Btn_MinimizeMouseUp end object L_Minimize: TLabel Left = 251 Top = -1 Width = 7 Height = 13 Hint = #1057#1082#1088#1099#1090#1100' '#1087#1088#1086#1075#1088#1072#1084#1084#1091' '#1073#1077#1079' '#1086#1089#1090#1072#1085#1086#1074#1082#1080' '#1087#1088#1086#1094#1077#1089#1089#1072' '#1086#1073#1088#1072#1073#1086#1090#1082#1080' '#1092#1072#1081#1083#1086#1074'. ('#1045#1089#1083#1080' ' + #1085#1072#1095#1072#1090')' Caption = '_' Font.Charset = DEFAULT_CHARSET Font.Color = clBtnText Font.Height = -11 Font.Name = 'Tahoma' Font.style="[fsBold]" ParentFont = False ParentShowHint = False ShowHint = True Transparent = True OnMouseUp = Btn_MinimizeMouseUp OnMouseEnter = Btn_MinimizeMouseEnter OnMouseLeave = Btn_MinimizeMouseLeave end object L_Caption: TLabel Left = 4 Top = 2 Width = 229 Height = 13 AutoSize = False Caption = 'MP3 Files Sorter - '#1044#1086#1073#1072#1074#1083#1077#1085#1080#1077' '#1087#1072#1087#1082#1080 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.style="[fsBold]" ParentFont = False Transparent = True OnMouseDown = Pan_TitleMouseDown end object ToolBar: TToolBar Left = 0 Top = 18 Width = 296 Height = 19 Align = alBottom AutoSize = True ButtonHeight = 19 ButtonWidth = 70 Drawingstyle="dsGradient" GradientEndColor = 11982554 List = True ShowCaptions = True TabOrder = 0 Transparent = True end end object Pan_Main: TPanel Left = 0 Top = 39 Width = 300 Height = 92 Align = alClient BevelKind = bkFlat BevelOuter = bvNone TabOrder = 1 object Progress: TProgressCyl AlignWithMargins = True Left = 2 Top = 16 Width = 293 Height = 23 Hint = #1057#1090#1088#1086#1082#1072' '#1089#1086#1089#1090#1086#1103#1085#1080#1103'.' BackBorderColor = clBtnShadow BackColor = clBtnFace BackStyle.IntensityRGB = 255 BackStyle.Intensity = 4.000000000000000000 BackStyle.IntensityFactor = -1.000000000000000000 BackStyle.RangeRGB = 255 BackStyle.ColorRGB = 255 BackStyle.ColorFactor = -1.000000000000000000 BackStyle.LightAngle = -3.000000000000000000 BevelColor = clBtnHighlight BevelInner = bvNone BevelOuter = bvNone BevelWidth = 1 BorderWidth = 0 Color = clBtnFace CylinderEffect = ceUltraLow Font.Charset = DEFAULT_CHARSET Font.Color = clBlack Font.Height = -11 Font.Name = 'Arial' Font.style="[fsBold]" FontEffect = feShadowTopLeft FontOrientation = foLeftToRight FontShadowColor = clBtnFace ForeColor = clWhite ForeLineColor = clHighlight ForeStyle.IntensityRGB = 255 ForeStyle.Intensity = 4.000000000000000000 ForeStyle.IntensityFactor = -1.000000000000000000 ForeStyle.RangeRGB = 255 ForeStyle.ColorRGB = 255 ForeStyle.ColorFactor = -1.000000000000000000 ForeStyle.LightAngle = -3.000000000000000000 Max = 100 Orientation = pbHorizontal ParentFont = False ParentShowHint = False Position = 0 ProEffect = peCustom ShowHint = True ShowText = True Text = '%' TextDone = #1043#1086#1090#1086#1074'...' Step = 1 StopAtMax = True end object L_Progress: TLabel Left = 4 Top = 2 Width = 115 Height = 13 Caption = #1055#1088#1086#1075#1088#1077#1089#1089' '#1074#1099#1087#1086#1083#1085#1077#1085#1080#1103':' Transparent = True end object L_Status: TLabel Left = 6 Top = 40 Width = 285 Height = 95 AutoSize = False Caption = #1055#1086#1076#1086#1078#1076#1080#1090#1077', '#1080#1076#1077#1090' '#1087#1086#1076#1089#1095#1077#1090' '#1082#1086#1083#1083#1080#1095#1077#1089#1090#1074#1072' '#1092#1072#1081#1083#1086#1074'...' Transparent = True WordWrap = True end object Btn_Cancel: TALButton AlignWithMargins = True Left = 194 Top = 62 Width = 100 Height = 23 Hint = #1054#1090#1084#1077#1085#1080#1090#1100' '#1076#1086#1073#1072#1074#1083#1077#1085#1080#1077' '#1092#1072#1081#1083#1086#1074 Focusstyle="ALFSNone" BorderColor = clBtnShadow GlyphIndex = 5 Glyph = Frm_Main.ImgL_Buttons Caption = #1054#1090#1084#1077#1085#1072 ParentShowHint = False ShowHint = True TabOrder = 0 OnClick = Btn_CancelClick OnPaint = Btn_CancelPaint end end end --------- Обращаться в ICQ: 66550088 (Ally) или E-Mail: AvePassion@GMail.Com

Ответ отправил: Уваров Андрей Александрович (статус: Студент) Ответ отправлен: 26.08.2007, 20:42 Оценка за ответ: 5

Вопрос № 99.745

Здрасти как сделать чтоб программа запускалась когда Windows полностью загрузился. А то моя программа запускаеться когда окно ПРИВЕТСВИЕ . (Программа без интерфейса) ??!

Отправлен: 26.08.2007, 20:22 Вопрос задал: Василий Васильевич Сквозняков (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Уваров Андрей Александрович Здравствуйте, Василий Васильевич Сквозняков! Windows уже загрузился, это загружается рабочий стол и программы. К сожелению никак нельзя сделать чтобы программа запустилась только когда все остальные закончат работу. Можно попробовать принудительно ожидать например 20 сек., тогда можно быть уверенным что почти все загрузилось. Так же вы можете попробовать отслеживать загрузку CPU, но тут можно очень сильно просчитаться. Так как какая-нибудь программа может сразу начать грузить процессор. --------- Обращаться в ICQ: 66550088 (Ally) или E-Mail: AvePassion@GMail.Com

Ответ отправил: Уваров Андрей Александрович (статус: Студент) Ответ отправлен: 26.08.2007, 20:46

Отвечает: Виктор Пырлик Здравствуйте, Василий Васильевич Сквозняков! Да поместите в автозапуск и всё. Программа не будет запускаться "когда окно приветствие", потому что, это отрабатывает для конкретного пользователя и на стадии регистрации пользователь не известен. --------- Если ничего не помогло - надо читать инструкцию

Ответ отправил: Виктор Пырлик (статус: Студент) Ответ отправлен: 26.08.2007, 23:25

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.58 от 30.08.2007
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru