Предлагаю исходный текст рабочей программы (встраиваемой процедуры Дельфи) на Ассемблере,
реализующей алгоритм теста Люка-Лемера для определения простоты произвольных чисел Мерсенна.
Напомню суть теста: число Мерсенна M=2^p-1, где р-простое, будет простым, если построив последовательность вычетов Vn (n=1…p-1) следущего вида: V1=4; Vn = (Vn-1*Vn-1 mod 2^p-1) -2 (n=2…p-1) получим Vp-1=0. Для p<32 данный алгоритм реализуется тривиально, для p>32 есть определенные трудности. (читать всё…)

(читать всё…)

(читать всё…)

Написал свой вариант: http://dl.dropbox.com/u/201788/Projects/AutorunReg.pas

Как использовать:
1а. Положить модуль в папку с программой.
либо
1б. Положить модуль в любое место и в проекте использовать Project/Add to project.
2. Подключить модуль в uses: (читать всё…)

Азбука Морзе

В азбуке Морзе (код Морзе) каждой букве соответствует комбинация из длинных посылок (тире) и коротких посылок (точек). За единицу длительности в телеграфной азбуке принимается длительность точки. Длительность тире равняется длительности трех точек. Пауза между знаками в букве – одна точка, а между буквами в слове 3 точки. Пауза между словами 7 точек.

(читать всё…)

Файлы представлены в виде сбалансированного дерева. Сканирование папки осуществляется нажатием на выделенную правой кнопкой мышки (читать всё…)

Хочу поделиться с Вами приладой для учета флешек.
Постановка задачи была следующая: существует утвержденный список сертифицированных флешек, которыми можно пользоваться и есть специалист по безопасности, который за это отвечает. С помощью этой прилады можно: спалить кого угодно на предмет втыкания в комп левых флешек, настроить все компы на использование флешек необходимым образом, удалить всю информацию из реестра об установленных флешках (тем самым прикрыв свою задницу в случае грядущей проверки из вышестоящей инстанции) и еще кое-что.

автор: dab00

Скачать VBA и HTA версии можно здесь: http://da440dil.narod.ru

VBA версию попробую вложить.
Код, конечно, некрасивый – не оптимизированный – тем не менее работает.

тема на форуме

Здравствуйте, уважаемые форумчане!
Представляю вашему вниманию скрипт для удаления комментариев – апострофа (символа » ‘ «), пробелов, табуляций из файлов исходного кода на VB – в вашем случае модулей .bas – нет на форуме темы VB – Excel (VBA) самая подходящая.
Скрипт создает новый файл с префиксом «New-». Работает в графическом и консольном режиме. Использует регулярные выражения, поэтому довольно шустрый. (читать всё…)

(читать всё…)

(читать всё…)

(читать всё…)

Ребята, QueryPerformanceCounter и всякие высокоточные таймеры – это конечно хорошо, но вы не учитываете две вещи:

1. Windows – система многозадачная, процессор(ы) – ресурс ограниченный. Различные потоки конкурируют за этот ресурс, а планировщик Windows управляет кому и когда отдать квант процессорного времени, при этом остальные потоки будут мирно ждать своей очереди. Вы не можете из программы прямо управлять планировщиком (только косвенно путем выставления приоритетов) и не знаете, когда у вашего потока заберут квант. Может получиться, что нужный интервал в 0,1 мс растянется на неопределенно долгое время.
2. Работа с портами (автору нужно отправлять запросы на порт) в Windows осуществляется также, как и с файлами – через драйверы файловых систем. Все запросы таким драйверам асинхронны по определению (даже если вызвать функцию ввода/вывода в синхронном режиме), т.е. мы просто кладем в некую очередь запрос на операцию, которая будет выполнена когда-нибудь кем-нибудь. При синхронном вызове функция просто дожидается окончания асинхронной операции. Когда операция будет выполнена – также определяет планировщик. (читать всё…)

(читать всё…)

Третья моя программа написана по наработкам второй(для создания электронных книг), поэтому содержит некоторые методы такого же названия например «openBookBase», что в последующих версиях будет исправлено на «openTestBase»

Программа представляет собой миникомплекс, включающий: создание, тестирование, отчёт(статистика). (читать всё…)

Да. Можно ли это в делфи организовать? (читать всё…)

Выкладываю обещанную библиотеку для шифрования данных по алгоритму описанным мною в статье Шифровка данных заменой. Борьба с избыточностью а также программу-пример на Delphi использующую её.

	rclib.zip (10.5 Кб)
	rdctool.zip (233.2 Кб)

тема на форуме

Решил я тут выложить в свободный доступ исходник программы для создания кроссвордов. (читать всё…)

(читать всё…)

Windows Сапёр в Delphi – сама игра и её решение.
(читать всё…)

alexinspir:
Test-Driven Development (TDD, разработка через тестирование) является одной из основополагающих техник экстремального программирования, но к сожалению, в россии очень немногие разработчики умеют ею пользоваться.
Разработка через тестирование подразумевает следующие этапы, которые в 90% случаев идут строго по порядку(об оставшихся 10% скажу позднее):
(читать всё…)

KARUSHEV:
Поставленная задача:
Пользователь вводит с клавиатуры: вклад и проценты. Программа должна подсчитать за какое время увеличится вклад в три раза и вывести конечную сумму денег.
(читать всё…)

(читать всё…)

Двойной вывод этим стилем приводит к тому, что после первого – выводится изображение, а после второго – производится восстановление предыдущего состояния, т.е. выполняется стирание.

Пример в дельфи.

Тема на форуме.

Alexei91:

Исходник прилагаю.
Т.к. пример достаточно простой,нужно указывать откуда копировать файла + имя коп. файла и куда копировать + имя коп. файла- так что нужные функции дальше сами добавите.
Почитайте книжку А.Чиртик … “Delphi Трюки&Эффекты”.
Красивое копирование файла.zip

unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, ComCtrls;

type
   TForm1 = class(TForm)
     Label1: TLabel;
     pbCopyProgress: TProgressBar;
     cmbCopy: TButton;
     txtFrom: TEdit;
     txtTo: TEdit;
     Label2: TLabel;
     procedure cmbCopyClick(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

var
   Form1: TForm1;

implementation
var
   progress: TProgressBar;
   bCancelCopy: BOOL;

{$R *.dfm}

//Функция обратного вызова для отображения хода копирования
function CopyProgressFunc( TotalFileSize: Int64;
      TotalBytesTransferred: Int64;
     StreamSize: Int64;
     StreamBytesTransferred: Int64;
     dwStreamNumber: DWORD;
     dwCallbackReason: DWORD;
     hSourceFile: THandle;
     hDestinationFile: THandle;
     lpData: Pointer ): DWORD; stdcall;
begin
   progress.Position := 100 * TotalBytesTransferred div TotalFileSize;
   Application.ProcessMessages; //Чтобы не “зависал” интерфейс приложения
   CopyProgressFunc := PROGRESS_CONTINUE;
end;

procedure TForm1.cmbCopyClick(Sender: TObject);
begin
   if cmbCopy.Caption = ‘Копировать’ then
   begin
     //Запускаем копирование
     progress := pbCopyProgress; //Настроен от 0 до 100%
     bCancelCopy := FALSE;
     cmbCopy.Caption := ‘Отмена’;
     if CopyFileEx(PAnsiChar(txtFrom.Text), PAnsiChar(txtTo.Text),
       Addr(CopyProgressFunc), nil, Addr(bCancelCopy),
       COPY_FILE_FAIL_IF_EXISTS) = FALSE
     then
       MessageBox(Handle, ‘Не удается скопировать файл’, ‘Копирование’,
       MB_ICONEXCLAMATION);
   end
   else
   begin
     //Останавливаем процесс копирования
     bCancelCopy := TRUE;
     cmbCopy.Caption := ‘Копировать’;
   end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   //Останавливаем процесс копирования
   bCancelCopy := TRUE;
end;

end.

Тема на форуме

function vk_login(Login, Pass : string; IdHTTP : TIdHTTP): Boolean;
var
  sl : TStringList;
  text : string;
begin
  sl := TStringList.Create;
  sl.Add('email=' + Login + '&pass=' + Pass + '&expire=&vk=');
  text := IdHTTP.Post('http://login.vk.com/?act=login',sl);
  if Pos('Aoia',text)<>0 then begin
    MessageBox(Application.Handle,'Iaaa?iua aaiiua: Eiaei , Ia?ieu','Ioeaea',0);
    Result := False;
  end else begin
    text := Copy(text,Pos('name=' + #39 + 's' + #39,text)+16,PosEx(#39,text,Pos('name=' + #39 + 's' + #39,text)+17)-Pos('name=' + #39 + 's' + #39,text)-16);
    IdHTTP.Request.CustomHeaders.Add('Cookie:remixchk=5; remixsid=' + text);
    Result := True;
  end;
  sl.Free;
end;

vk_login(Edit1.Text,Edit2.Text,IdHTTP1);

function VK_ParsEmail(s:string; IdHTTP1:TIdHTTP): TStringList;
var
  i : Integer;
  mess_full, mess_text,
  mess_id, mess_new,
  mess_aut, mess_aut_id,
  mess_date, mess_title : string;
  sl : TStringList;
begin
  Result := TStringList.Create;
  i := 1;
  s := Copy(s,PosEx('</tr>',s,Pos('<div id="messages_wrap">',s))+6,PosEx('</table>',s,Pos('<div id="messages_wrap">',s))-PosEx('</tr>',s,Pos('<div id="messages_wrap">',s))-6);
  while PosEx('<tr ',s,i)<>0 do
  begin
    mess_full := Copy(s,PosEx('<tr ',s,i),PosEx('</tr>',s,PosEx('<tr ',s,i))-PosEx('<tr ',s,i));

    // Iieo?aiea id niiauaiey
    mess_id := Copy(mess_full,Pos('id="',mess_full)+8,PosEx('"',mess_full,Pos('id="',mess_full)+9)-Pos('id="',mess_full)-8);

    // iiaia ee yoi niiauaiea
    if Pos('class='+#39+'newRow'+#39,mess_full)<>0 then mess_new := '1' else mess_new := '0';

    if mess_new = '1' then
    begin
      // Io eiai niiauaiea
      mess_aut := Copy(mess_full,PosEx('">',mess_full,Pos('<div>',mess_full)+19)+2,PosEx('</a>',mess_full,PosEx('">',mess_full,Pos('<div>',mess_full)+19)+3)-PosEx('">',mess_full,Pos('<div>',mess_full)+19)-2);

      // EA iieuciaaoaey, eioi?ue i?eneae niiauaiea
      mess_aut_id := Copy(mess_full,Pos('href="',mess_full)+7,PosEx('">',mess_full,Pos('href="',mess_full)+8)-Pos('href="',mess_full)-7);

      // Aaoa, eiaaa i?eoei niiauaiea
      mess_date := Copy(mess_full,Pos('class="date">',mess_full)+13,PosEx('</div',mess_full,Pos('class="date">',mess_full)+14)-Pos('class="date">',mess_full)-13);

      //Oaia niiauaiey
      mess_title := Copy(mess_full,PosEx('<span>',mess_full,Pos('new messageSubject',mess_full))+6,PosEx('</span>',mess_full,Pos('new messageSubject',mess_full))-PosEx('<span>',mess_full,Pos('new messageSubject',mess_full))-6);

      // Oaeno niiauaiey
      mess_text := IdHTTP1.Get('http://vkontakte.ru/mail.php?act=show&id='+ mess_id);
      mess_text := Copy(mess_text,PosEx(';">',mess_text,Pos('class="messageText"',mess_text))+3,PosEx('</div>',mess_text,Pos('class="messageText"',mess_text))-PosEx(';">',mess_text,Pos('class="messageText"',mess_text))-3);
    end;

    Result.Add(mess_aut+' '+mess_aut_id+' '+mess_date+' '+mess_text);
    i := PosEx('<tr ',s,i)+2;
    Sleep(300);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines := VK_ParsEmail(IdHTTP1.Get('http://vkontakte.ru/mail.php'),IdHTTP1);
end;

Следите за темой на форуме. Форумчанин Dionix настроен серьезно.

Вложения

Parser.rar (7.5 Кб)

Тема на форуме.

[MoNAMur]:

отрыл у себя на компьютере в папке “раритет” эти исходники.

интересно ваше мнение по поводу кода и полезности программы)))
да и может кому то понадобится какой-нибудь кусок кода.

программа получает данные о некоторых железках…

Исходник программы
Тема на форуме

Переопределяем SampleGrabber и получаем каждый кадр в свой буфер, его выводим куда и чем угодно Вам.

type
  TArRGBTriple = array[0..0] of TRGBTriple;
  PArRGBTriple = ^TArRGBTriple;

function GetPin(pFilter: IBaseFilter; PintDir: TPinDirection): IPin;
procedure RemoveDefault(pGraph: IGraphBuilder; pNULLRenderer, pGrabberBase: IBaseFilter);

implementation

function GetPin(pFilter: IBaseFilter; PintDir: TPinDirection): IPin;
var
  bFound: Boolean;
  pEnum: IEnumPins;
  pPin: IPin;
  hr: HRESULT;
  PinDirThis: TPinDirection;
begin
  Result := NIL;
  bFound := False;

  hr := pFilter.EnumPins(pEnum);
  if Failed(hr) then
    Exit;

  while (pEnum.Next(1, pPin, NIL) = S_OK) do
  begin
    pPin.QueryDirection(PinDirThis);
    bFound := (PintDir = PinDirThis);
    if bFound then
      Break;
    pPin := NIL;
  end;

  pEnum := NIL;
  if bFound then
    Result := pPin;
end;

procedure RemoveDefault(pGraph: IGraphBuilder; pNULLRenderer, pGrabberBase: IBaseFilter);
var
  pVidRenderer, pColorConverter: IBaseFilter;
  Pin, oPin: IPin;
begin
  pGraph.FindFilterByName('Video Renderer', pVidRenderer);
  if (pVidRenderer <> NIL) then
  begin
    Pin := GetPin(pVidRenderer, PINDIR_INPUT);
    oPin := NIL;
    Pin.ConnectedTo(oPin);
    Pin.Disconnect;
    oPin.Disconnect;
    Pin := NIL;

    pGraph.RemoveFilter(pVidRenderer);
    pVidRenderer := NIL;

    pGraph.FindFilterByName('Color Space Converter', pColorConverter);
    if (pColorConverter <> NIL) then
    begin
      oPin := NIL;
      Pin := GetPin(pColorConverter, PINDIR_INPUT);
      Pin.ConnectedTo(oPin);
      Pin.Disconnect;
      oPin.Disconnect;
      Pin := NIL;

      pGraph.RemoveFilter(pColorConverter);
      pColorConverter := NIL;
    end;

    Pin := GetPin(pGrabberBase, PINDIR_INPUT);
    pGraph.Connect(oPin, Pin);
    Pin := NIL;
    oPin := NIL;

    oPin := GetPin(pGrabberBase, PINDIR_OUTPUT);
    Pin := GetPin(pNULLRenderer, PINDIR_INPUT);

    pGraph.Connect(oPin, Pin);
    Pin := NIL;
    oPin := NIL;
  end;
end;

пример набросок

...
TfrmExample = class(TForm, ISampleGrabberCB)
private
    function SampleCB(SampleTime: Double; pSample: IMediaSample): HResult; stdcall;
    function BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: longint): HResult; stdcall;
...
    GraphBuilder: IGraphBuilder;
    FilterSampleGrabber: IBaseFilter;
    SampleGrabber: ISampleGrabber;
    MediaControl: IMediaControl;
    MediaPosition: IMediaPosition;
    NullRenderer: IBaseFilter;
end;

...

function TfrmExample.BufferCB(SampleTime: Double; pBuffer: PByte;
  BufferLen: Integer): HResult;
begin
  Result := S_OK;
end;

function TfrmExample.SampleCB(SampleTime: Double; pSample: IMediaSample): HResult;
var
  BmpHead: PBitmapInfoHeader;
  MediaType: TAMMediaType;
  DIBSize: Integer;
  pBuffer: PByte;
begin
  Result := S_OK;

  if (pSample.GetSize = 0) then
    Exit;

  Result := SampleGrabber.GetConnectedMediaType(MediaType);
  if Failed(Result) then
    Exit;

  if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
  begin
    BmpHead := NIL;
    if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
    begin
      if (MediaType.cbFormat = SizeOf(TVideoInfoHeader)) then
        BmpHead := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
    end;
    if (BmpHead = NIL) then
      Exit;

    DIBSize := BmpHead^.biSizeImage;
    if (DIBSize = 0) then
    begin
      with BmpHead^ do
        DIBSize := 3 * biWidth * biHeight * biPlanes;
      BmpHead^.biSizeImage := DIBSize;
    end;

    pSample.GetPointer(pBuffer);

    // вот необходимые данные для работы с растром текущего кадра
    // BmpHead^.biWidth, BmpHead^.biHeight, BmpHead^.biWidth * 3, PixelFormat24bppRGB, pBuffer
  end;
end;

как запускать Play/Pause/Stop

procedure TfrmExample.Play;
var
  MediaType: TAMMediaType;
  Result: HRESULT;
begin
  GraphBuilder := NIL;
  FilterSampleGrabber := NIL;
  SampleGrabber := NIL;
  MediaControl := NIL;
  MediaPosition := NIL;
  NullRenderer := NIL;

  CoCreateInstance(CLSID_FilterGraph, NIL, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, GraphBuilder);

  Result := GraphBuilder.RenderFile(PWCHAR(WideString('My Video File')), NIL);
  if Failed(Result) then
    Exit;

  CoCreateInstance(CLSID_SampleGrabber, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, FilterSampleGrabber);
  FilterSampleGrabber.QueryInterface(IID_ISampleGrabber, SampleGrabber);

  FillChar(MediaType, SizeOf(MediaType), 0);
  MediaType.majortype := MEDIATYPE_Video;
  MediaType.subtype := MEDIASUBTYPE_RGB24;
  SampleGrabber.SetMediaType(MediaType);
  SampleGrabber.SetBufferSamples(True);
  SampleGrabber.SetOneShot(False);
  SampleGrabber.SetCallback(Self, 0);
  GraphBuilder.AddFilter(FilterSampleGrabber, 'Sample Grabber');

  CoCreateInstance(CLSID_NullRenderer, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, NullRenderer);
  GraphBuilder.AddFilter(NullRenderer, 'Null Renderer');

  RemoveDefault(GraphBuilder, NullRenderer, FilterSampleGrabber);

  GraphBuilder.QueryInterface(IID_IMediaControl, MediaControl);
  GraphBuilder.QueryInterface(IID_IMediaPosition, MediaPosition);

  MediaPosition.get_Duration(VideoLen);
  MediaControl.Run;
end;

procedure TfrmExample.Pause;
begin
  MediaControl.Pause;
end;

procedure TfrmExample.Stop;
begin
    MediaControl.StopWhenReady;
    FilterSampleGrabber := NIL;
    SampleGrabber := NIL;
    MediaControl := NIL;
    MediaPosition := NIL;
    NullRenderer := NIL;
    GraphBuilder := NIL;
end;

Подробнее на форуме.

1. Средствами самой ОС.

1) ХР.
Пуск – Выполнить.
Введите команду winmsd.exe и нажмите ОК.
2) Vista
Пуск. Введите система в поле Начать поиск и затем щелкните пункт Сведения о системе в списке Программы.
Если в панели навигации выбран пункт Сводные сведения о системе, то сведения об операционной системе отображаются указанным ниже образом.
* Для 64-разрядной версии операционной системы. Фраза Компьютер на базе x64 отображается в пункте Тип системы в разделе Элемент.
* Для 32-разрядной версии операционной системы. Фраза Компьютер на базе x86 отображается в пункте Тип системы в разделе Элемент.

2. Самодельная программа и исходник.

Вложения

Test_Proj.rar (158.1 Кб)

Тема на форуме.

Пример. Лежат исходники и готовая программа.

Вложения

WAVE.rar (36.0 Кб)

Тема на форуме.