[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

Form1.Cursor:=crNone;

Если же тебе понадобится особенный курсор:

Открываешь файл ресурсов твоей программы (файл этот автоматически создаётся и имеет имя твоей проги.res) стандартной программой ImageEditor. Она сразу с дельфёй идет... Или, мона другими редакторами ресурсов - XN, Restorator... Можешь создать свой файл ресурсов...

Там добавляешь группу курсоров... Правда в стандартном дельфийском ImageEditore только Ч/Б курсоры... , но если тебе понадобиться не Ч/Б, а разноцветный юзай XN resource editor... Курсор именуешь как нибудь... "cur_name" например...

Потом прописываешь после слова implementation

{$R <имя твоего файла ресурсов>.res}

на создание формы пишушь:

Screen.Cursors[5] := LoadCursor(HInstance, 'cur_name'); //заргужаешь курсор
Form1.Cursor := 5; // теперь над формой 1 будет твой курсор...

Таких ты можешь нарисовать много и потом просто загружать их в screen.Cursirs[n]...

 

Нужен код который будет:

1) Забирать значение поля (text) edit1
2) Искать это значение в файле name.txt (До знака ":")
3) Выводить значение (Только после ":") этой строчки в поле (text) edit2

Пример:

Фаил: name.txt

Code:

1:2
3:4
5:6
7:8
9:10
11:12
13:14
и, т.д.

Значение поля (text) edit1: 5
Значит значение поля (text) edit2 должно быть: 6

 

типа так, компилятора под рукой нет, так что проверить не могу

Code:

var
 mas:array of string;
 cnt:integer;
 f:texfile;
x:integer;
s:string;
begin
 assignfile(f,'name.txt');
reset(f);
cnt:=0;
 while not eof(f) do
   begin
     inc(cnt);
    setlength(mas,cnt)
    readln(f,mas[cnt-1]);
   end;
closefile(f);
.............
for x:=0 to cnt-1 do
 begin
  if copy(mas[x],1,pos(':',mas[x])-1)=edit1.text then 
   begin
    s:=mas[x];
   delete(s,1,pos(':',s));
    edit2.text:=s;
    break;
  end;
end;

 

Например вот так:

Code:

procedure TForm1.Button3Click(Sender: TObject);
var
  f: TextFile;
  s,d: String;
  i: Integer;
begin
  d:=Edit1.Text;
  AssignFile(f,'name.txt');
  Reset(f);
  while not eof(f) do
  begin
    ReadLn(f,s);
    i:=pos(':',s);
    if d=copy(s,1,i-1) then
    begin
      Edit2.Text:=copy(s,i+1,Length(s)-i+1);
      Break;
    end;
  end;
  CloseFile(f);
end;

 

последния ошибка, чем ево объявить?

 

Здесь без единой ошибочки... спс вам

 

А в моем случае тоже без ошибки было, это я просто очепятался и пересохранил. Код от art2222 хорошо когда не нужно делать много таких операций, в моём случае я просто загнал всё в динамический массив

 

вот На C+++

HTML:

#include <windows.h>
#include"stdio.h"
HDC hDC;
RECT rect;
static HWND wedit;
static HWND wedit1;
HWND hWnd;
FILE*f;
BYTE chBuff[80],c[80],k,n=0;
int i=0;
WORD cbText;
WNDCLASS wc;

HINSTANCE hInst;
LRESULT CALLBACK WndProc(HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam);


int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,LPSTR lpCmdLine, int nCmdShow)
{
LPCSTR AppName = "Прога";
MSG msg;
hInst = hInstance;
WNDCLASS wc;
ZeroMemory(&wc, sizeof(wc));
wc.style = CS_HREDRAW | CS_VREDRAW;
wc.lpfnWndProc = (WNDPROC)WndProc;
wc.hInstance = hInst;
wc.hIcon = LoadIcon(hInst, IDI_APPLICATION);
wc.hCursor = LoadCursor(NULL, IDC_ARROW);
wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1);
wc.lpszClassName = AppName;
RegisterClass(&wc);
hWnd = CreateWindow(AppName,AppName,WS_OVERLAPPEDWINDOW,CW_USEDEFAULT, 0,100, 130,NULL,NULL,hInst,NULL);
FreeConsole();
ShowWindow(hWnd, SW_SHOW); // Отображаем окно
UpdateWindow(hWnd); // Перерисовываем окно
while(GetMessage(&msg, NULL, 0, 0))
{
TranslateMessage(&msg);
DispatchMessage(&msg);
}
return msg.wParam;
}

LRESULT CALLBACK WndProc(HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam)
{
switch(msg)
{
case WM_CREATE:
CreateWindow("BUTTON","OK",WS_CHILD|BS_PUSHBUTTON|WS_VISIBLE,10,60,90,20,hWnd,0,1,NULL);
wedit=CreateWindow("edit", "",WS_CHILD | WS_VISIBLE| WS_BORDER| ES_CENTER | ES_MULTILINE | ES_WANTRETURN ,5, 5, 100, 20, hWnd, NULL, 1, NULL);
wedit1=CreateWindow("edit", "",WS_CHILD | WS_VISIBLE | WS_BORDER| ES_CENTER| ES_MULTILINE | ES_WANTRETURN ,5, 30, 100, 20, hWnd, NULL, 1, NULL);
SetFocus(wedit);
break;

case WM_DESTROY:
PostQuitMessage(0);
break;

case WM_COMMAND:
hDC=GetDC(hWnd);
switch(LOWORD(wParam))
{
case 0://событие от первой кнопки
if (HIWORD(wParam)==BN_CLICKED)
{
*(WORD*) chBuff = sizeof (chBuff) - 1;
cbText = SendMessage(wedit, EM_GETLINE, 0,(LPARAM)(LPSTR)chBuff);
chBuff[cbText] = '\0';
if((f=fopen("name.txt","r"))==NULL)
{
SetWindowText(wedit1,(LPSTR)(LPCSTR)"ошибка");
}
i=0;
n=0;
while(fscanf(f,"%c",&k),!feof(f))
{
if((k>='0')&&(k<='9'))
{
c[i]=k;
i++;
}
else
{
c[i]='\0';
i=0;
if((k==':')&&(strcmp(c,chBuff)==0))
{
while(fscanf(f,"%c",&c[i]),((c[i]>='0')&&(c[i]<='9')))
{
i++;
}
c[i]='\0';
SetWindowText(wedit1,(LPSTR)(LPCSTR)c);
n=1;
}
}
}
fclose(f);
if(n==0)
{
SetWindowText(wedit1,(LPSTR)(LPCSTR)"не найдено");
}
}
break;
};
DeleteObject(hDC);
break;
default:
return DefWindowProc(hWnd, msg, wParam, lParam);
}

return 0;
}

 

по вервому вопросу - когдато нужна была подобная прога.
Вот код - перебирает все диски в системе и берет их тип шины, тип а также кучу другйо инфы. Тебе достаточно тока выдрать отсюда код для определения типа насителя и чекнуть на BusTypeUsb

Code:

var
query:array[0..11] of byte = (00, 00, 00, 00, 00, 00, 00, 00, 00, 08, 00, 00);
type
 Storage_Bus_Type = ( BusTypeUnknown, BusTypeScsi, BusTypeAtapi, BusTypeAta,
                     BusType1394, BusTypeSsa, BusTypeFibre, BusTypeUsb, BusTypeRAID );

type
PSTORAGE_DEVICE_DESCRIPTOR=record
Version:dword;
Size:dword;
DeviceType:UCHAR;
DeviceTypeModifier:UCHAR;
RemovableMedia:BOOLEAN;
CommandQueueing:BOOLEAN;
VendorIdOffset:dword;
ProductIdOffset:dword;
ProductRevisionOffset:dword;
SerialNumberOffset:dword;
BusType:STORAGE_BUS_TYPE;
RawPropertiesLength:dword;
RawDeviceProperties:array[1..500]of CHAR;
end;

function getValue(buf:PSTORAGE_DEVICE_DESCRIPTOR;offs:dword):string;
var
mas:array[0..255] of char;
begin
if offs=0 then exit;
asm
push eax
push ebx
push edx
push esi
push edi
xor edi,edi
xor esi,esi
mov esi,offs
lea edx,buf
lea ebx,mas
@m1:
mov al,[edx+esi]
mov [ebx+edi],al
inc edi
inc esi
cmp al,0
jne @m1
pop edi
pop esi
pop edx
pop ebx
pop eax
end;
result:=string(mas);
end;

function NUM(s:string):boolean;
begin
result:=true;
case s[1] of
'0'..'9','A'..'F','a'..'f':;
else result:=false;
end;
case s[2] of
'0'..'9','A'..'F','a'..'f':;
else result:=false;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hDevice:THANDLE;
status:BOOLean;
returnedLength:ULONG;
devDesc:pSTORAGE_DEVICE_DESCRIPTOR;
s,ss:string;
c:char;
x,y:integer;
begin
stringgrid1.Rows[stringgrid1.RowCount].Clear;
stringgrid1.Cells[0,0]:='Диск';
stringgrid1.Cells[1,0]:='VendorId';
stringgrid1.Cells[2,0]:='ProductId';
stringgrid1.Cells[3,0]:='ProductRev';
stringgrid1.Cells[4,0]:='Размещение';
stringgrid1.Cells[5,0]:='SerialNumber';
x:=1;
for c:='A' to 'Z' do begin
hDevice:=CreateFile(pansichar('\\.\'+c+':'), GENERIC_READ + GENERIC_WRITE, FILE_SHARE_READ + FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
status:=DeviceIoControl( hDevice, $002d1400, @query, sizeof(query), @devDesc, 512, cardinal(returnedLength), nil );
if status then
 begin
   stringgrid1.Cells[0,x]:=c;
//   if (devDesc.RemovableMedia) then memo1.Lines.Add('Removable Media');
   stringgrid1.Cells[1,x]:=getValue(devDesc,devDesc.VendorIdOffset);
   stringgrid1.Cells[2,x]:=getValue(devDesc,devDesc.ProductIdOffset);
   stringgrid1.Cells[3,x]:=getValue(devDesc,devDesc.ProductRevisionOffset);
   case devDesc.BusType of
     BusTypeUnknown:s:='Unknown';
     BusTypeScsi:s:='SCSI';
     BusTypeAtapi:s:='ATAPI';
     BusTypeAta:s:='ATA';
     BusType1394:s:='IEEE 1394';
     BusTypeSsa:s:='SSA';
     BusTypeFibre:s:='FIBRE';
     BusTypeUsb:s:='USB';
     BusTypeRAID:s:='RAID';
    end;
   stringgrid1.Cells[4,x]:=s;
   ss:=getValue(devDesc,devDesc.SerialNumberOffset);
   s:='';
   for y:=1 to length(ss) div 2 do
    begin
    if not NUM(copy(ss,y*2-1,2)) then break;
    s:=s+chr(strtoint('$'+copy(ss,y*2-1,2)));
    end;
   stringgrid1.Cells[5,x]:=s;
   inc(x);
  end;
end;
end;

end.

2) компы в локалке даже если и видятся, то не факт что ты сможешь залезть в нет. Копай в сторону netapi чтобы узнать все компы в сети, а потом на каждый ткнуться и проверить. Самораспространение пишишь ))

 

Всех приветствую! Помогите пожалуйста решить проблему. Мне нужно получить все ссылки с фрейма. Код в нете я нашёл, но выскакивает ошибка "в доступе отказано". Дальше выяснил, что эта ошибка появляется тогда, когда фрейм ссылается на другой домен или что-то в этом роде.
Было бы очень здорово, если б кто-нибудь помог кодом: поиск всех ссылок во фреймах.
Использовал этот код:

Code:

procedure TForm1.Button2Click(Sender: TObject); 
var 
  i: Integer; 
begin 
  Listbox1.Clear; 
  //if frames available 
  if Webbrowser1.OleObject.Document.Frames.Length <> 0 then 
  begin 
    //walk through all frames and get the url 
    //to the Listbox 
    for i := 0 to Webbrowser1.OleObject.Document.Frames.Length - 1 do 
    begin 
      Listbox1.Items.Add(Webbrowser1.OleObject.Document.Frames.item(i).Document.URL); 
    end; 
  end; 
end;

 

2 Nightmarе. Для того чтобы определить какие компы в сети и какие ресурсы доступны у них, нужно заюзать WNetOpenEnum -> WNetEnumResource->WNetCloseEnum

в инете поищи исходник на тему - Вывод Списка компьютеров в локальной сети.
Там когда ты получаеш WNetEnumResource
там в dwDisplayType будет указывать что это за тип рисурса (принтер, сервер,файл, дира итд итп.)
А там чуть рекурсивно вызывать всё

 

2 Archangelus попробуй поиграться с настройками IE.
В последних IE там сильно уж ужесточили безопасность. особеннов IE 8.
А так как WebBrowser пашет на основе IE то и все настройки распространяются на него. Лично у меня при IE8 никакими настройками не удалось это исправить.

MS наверное задумалась о безопасности в плане CDS(Cross-Domain Scripting) и залатала эту фичу.

Как вариант - ты можешь получить исходный код страници и там уже ручками отпарсить <iframe ... src= ...> Но тогда всё что будет создано через JS ты не сможешь найти.

 

файл в память

пишу base64 кодировшик файлов, как заменить FileOpen FileRead чем то другим... одним словом у меня программа из за использования модуля sysutils прибавляет в весе.. как обойтись без него или можно выдрать эти функции из него и засунуть в код своей программы... Дайте лучший совет

 

можно взять и скажем использовать стандартную схему паскаля..

 

Archangelus,незнаю, по идеи ошибки не должно быть. А пробывал перехватить событие? хотя бы чтобы ошибка не появлялась..

 

если не хочешь лишнего гемора, упакуй UPX

 

это я уже пробовал кодирует только один символ

 

Есть 2 формы .В главной крутится один поток из кода которого вызывается Form2.Show(); Естественно при этом 2я форма как только появляется то сразу виснет Как это можно обойти?
ЗЫ:ShowWindow несовсем неподходит,потому как на форме надо перед её вызовом изменить свойства нескольких контролов.

 

Ничего не получается. Реально даже не знаю что сделать можно в этом случае
Пробовал настройки покапать - тоже результата нет

 

Пока ничего не вышло

Если честно, не вышло даже с алгоритмами типа try..
Вот, измененный код.. все то же самое, вроде бы.. только вот я сделал, чтобы бонусы чаще выпадали, так можно чаще проверить события с ними..
Так.. проверено, что stack overflow происходит, когда без
бонуса щит берешь бонус замедления времени.. странно..

пожалуйста, помогите мне.. у меня ничего не выходит с этим сделать.. я хочу нормально работать с DirectX.. но что-то идет не так..

Вот новая ссылка: Скачать