source: ISPProgrammer/ISPprog/UISPprog.pas

Last change on this file was 370, checked in by chronos, 14 years ago
  • Modified: ISPProgrammer now use updated component oriented TJobProgressView from Common package.
File size: 16.6 KB
Line 
1unit UISPprog;
2
3{$mode delphi}
4
5interface
6
7{$IFDEF Windows}
8uses
9 Windows, Classes, SysUtils, UISPProgrammer, ISP, UJobProgressView, Globals,
10 PinsIO, Delays, Processors, MemBuffer, SerialFlash, ISP_Flash, Forms,
11 URegistry, Registry, PortsIO, CfgMgr, UCPUType;
12
13type
14
15 { TISPProg }
16
17 TISPProg = class(TISPProgrammer)
18 private
19 ChipSignature: string;
20 procedure BeginWork;
21 procedure EndWork;
22 procedure ResetOff;
23 protected
24 procedure SetCPUType(AValue: TCPUType); override;
25 procedure SetActive(AValue: Boolean); override;
26 public
27 constructor Create; override;
28 procedure Write(Job: TJob); override;
29 procedure Read(Job: TJob); override;
30 procedure Verify(Job: TJob); override;
31 procedure Erase; override;
32 procedure Reset; override;
33 function ReadIdentification: string; override;
34 procedure LoadFromRegistry(Root: HKEY; Key: string); override;
35 procedure SaveToRegistry(Root: HKEY; Key: string); override;
36 end;
37
38 TLPTinfo = packed record
39 num:DWORD;
40 baseaddr:DWORD;
41 end;
42 PLPTinfo = ^TLPTinfo;
43
44function GetLPTAddr(dev:PDEVINST; baseaddr:PDWORD):boolean;
45function EnumLPT(lpttab:PLPTinfo; maxports:integer):integer;
46
47var
48 lpttable: packed array[1..99] of TLPTinfo;
49
50{$ENDIF}
51
52implementation
53
54{$IFDEF Windows}
55
56uses
57 InpOut32;
58
59const
60 TempHexFile = 'Dump.hex';
61
62resourcestring
63 SReady = 'Ready';
64 SProgramOK = 'Program OK';
65 SNoDataInFile = 'No data in file';
66 SUnknownDevice = 'Can''t program locked or not known device.';
67 SCantEraseNotKnownDevice = 'Can''t erase not known device.';
68 SWriteError = 'Write error at address %s, byte written: %s, byte read: %s';
69 SEraseTimeout = 'Erasing timeout.';
70 SEraseError = 'Erasing error.';
71 SDeviceErased = 'Device erased.';
72 SNotKnown = 'NOT KNOWN (%s, %s, %s)';
73 SWait = 'Wait...';
74
75const
76 lptcom: TGUID = '{4d36e978-e325-11ce-bfc1-08002be10318}';
77
78
79function GetLPTAddr(dev:PDEVINST; baseaddr:PDWORD):boolean;
80var
81 res, res2:DWORD;
82 conf:LOG_CONF;
83 rsrc:RES_DES;
84 buf:array[0..255] of char;
85begin
86 Result:=false;
87 res := CM_Get_First_Log_Conf(@conf, dev^, ALLOC_LOG_CONF);
88 if (res <> CR_SUCCESS) or (conf = 0) then Exit;
89 res := CM_Get_Next_Res_Des(@rsrc, conf, ResType_IO, nil, 0);
90 if res <> CR_SUCCESS then Exit;
91 res2 := CM_Get_Res_Des_Data(rsrc, @buf, sizeof(buf), 0);
92 if res2 <> CR_SUCCESS then Exit;
93 baseaddr^ := PIO_RESOURCE(@buf)^.IO_Header.IOD_Alloc_Base and $ffff;
94 CM_Free_Log_Conf_Handle(conf);
95 Result:=true;
96end;
97
98function EnumLPT(lpttab:PLPTinfo; maxports:integer):integer;
99var
100 i:integer;
101 h:HDEVINFO;
102 devinfo_data:SP_DEVINFO_DATA;
103 res: BOOL;
104 dev_name:packed array[0..255] of char;
105 p1,p2:PChar;
106 lptnum, lptcnt, code:integer;
107begin
108 Result := -1;
109 h := SetupDiGetClassDevs(@lptcom, nil, 0, DIGCF_PRESENT or DIGCF_PROFILE);
110 if h = INVALID_HANDLE_VALUE then Exit;
111 i := 0;
112 lptcnt := 0;
113 repeat
114 devinfo_data.cbSize := sizeof(SP_DEVINFO_DATA);
115 res := SetupDiEnumDeviceInfo(h, i, @devinfo_data);
116 if res then
117 begin
118 if SetupDiGetDeviceRegistryProperty(h, @devinfo_data, SPDRP_FRIENDLYNAME,
119 nil, @dev_name, sizeof(dev_name), nil) then
120 begin
121 p1 := StrPos(dev_name, '(LPT');
122 if p1 <> nil then
123 begin
124 p2 := StrPos(p1, ')');
125 if (p2 <> nil) and (p2 > p1) and (p2 - p1 - 5 <= 1) then
126 begin
127 p2^ := #0;
128 Val(StrPas(p1+4), lptnum, code);
129 if (code = 0) and (lptnum >= 1) and (lptnum <= 99) then
130 begin
131 lpttab^.num := lptnum;
132 if GetLPTAddr(@devinfo_data.DevInst, @lpttab^.baseaddr) then
133 begin
134 Inc(lpttab);
135 Inc(lptcnt);
136 end;
137 end;
138 end;
139 end;
140 end;
141 end;
142 Inc(i);
143 until (not res) or (i = maxports);
144 SetupDiDestroyDeviceInfoList(h);
145 Result:=lptcnt;
146end;
147
148
149{ TISPProg }
150
151procedure TISPProg.Write(Job: TJob);
152var
153 res: string;
154 radr, veradr, pagemask, pagesize, minadr, maxadr: integer;
155 b, b1: byte;
156 buff: array[0..1055] of byte;
157 Dump: TStringList;
158begin
159 (*if FlashPgmLabel.Caption = '' then
160 begin
161 StatusBar1.SimpleText:='Specify Flash file name first';
162 Exit;
163 end;
164 StatusBar1.SimpleText:='';
165 Application.ProcessMessages;*)
166 Active := True;
167
168 if (devicenr = DEVICE_UNKNOWN) or (devicenr = DEVICE_LOCKED) or (flashsize = 0) then
169 begin
170 raise Exception.Create(SUnknownDevice);
171 //Exit;
172 end;
173 ClearBuffer(BUF_FLASH);
174 minadr := 0;
175 maxadr := 0;
176
177 // Save to temp file
178 try
179 Dump := TStringList.Create;
180 HexFile.SaveToStringList(Dump);
181 Dump.SaveToFile(UTF8Decode(GetTempDir(True) + DirectorySeparator + TempHexFile));
182 finally
183 Dump.Free;
184 end;
185
186 res := LoadFile(BUF_FLASH, FILE_TYPE_INTELHEX,
187 UTF8Decode(GetTempDir(True) + DirectorySeparator + TempHexFile),
188 flashsize, minadr, maxadr);
189 if res <> '' then
190 begin
191 raise Exception.Create(res);
192 //Exit;
193 end;
194 if (minadr >= flashsize) or (maxadr < 0) then
195 begin
196 raise Exception.Create(SNoDataInFile);
197 //Exit;
198 end;
199 LedOn;
200 //Application.ProcessMessages;
201
202 if (Signatures[devicenr].algo = ALGO_SERIALFLASH) then
203 SerialflashUnprotectAll;
204
205 if (proctype = PROC_TYPE_S8253) or (proctype = PROC_TYPE_S2051) or (proctype = PROC_TYPE_NEW51) or
206 ((proctype = PROC_TYPE_AVR) and (Signatures[devicenr].fpagesize <> 0)) then
207 begin
208 // AT89S8253, AT89S2051/4051, AT89S51/52, AVRs with page programming
209 pagesize:=Signatures[devicenr].fpagesize;
210 pagemask:=pagesize - 1;
211 minadr:=minadr and (not pagemask); // round down to page size
212 maxadr:=maxadr or pagemask; // round up to page size
213 radr:=minadr;
214 Job.Progress.Max := maxadr - minadr + 1;
215 while radr <= maxadr do begin
216 if (proctype = PROC_TYPE_AVR) and (flashsize > 1024*128) then
217 begin
218 // ATmega2560/2561
219 if (radr = minadr) or ((radr and $1ffff) = 0) then
220 ISPLoadExtendedAddress(radr);
221 end;
222 ISPWriteFlashPage (radr, @flashbuffer[radr]);
223 ISPReadFlashPage (radr, @buff);
224 for veradr:=radr to radr + pagesize - 1 do
225 begin
226 b:=flashbuffer[veradr];
227 b1:=buff[veradr - radr];
228 if b <> b1 then
229 begin
230 raise Exception.Create(Format(SWriteError, [IntToHex(veradr, 8), IntToHex(b, 2), IntToHex(b1, 2)]));
231 //LedOff;
232 end;
233 end;
234 radr := radr + pagesize;
235 Job.Progress.Value := radr - minadr;
236 if Job.Terminate then Break;
237 end;
238 Log(SProgramOK);
239 LedOff;
240 Exit;
241 end
242 else if (proctype = PROC_TYPE_DATAFLASH) or (proctype = PROC_TYPE_SERIALFLASH) then
243 begin
244 // AT45DBxx DataFlash
245 pagesize:=Signatures[devicenr].fpagesize;
246 minadr:=(minadr div pagesize) * pagesize; // round down to page size
247 maxadr:=(maxadr div pagesize) * pagesize + (pagesize - 1); // round up to page size
248 radr:=minadr;
249 while radr <= maxadr do
250 begin
251 ISPWriteFlashPage (radr, @flashbuffer[radr]);
252 ISPReadFlashPage (radr, @buff);
253 for veradr:=radr to radr + pagesize - 1 do
254 begin
255 b := flashbuffer[veradr];
256 b1 := buff[veradr - radr];
257 if b <> b1 then
258 begin
259 raise Exception.Create(Format(SWriteError, [IntToHex(veradr, 8), IntToHex(b, 2), IntToHex(b1, 2)]));
260 //LedOff;
261 //Exit;
262 end;
263 end;
264 radr := radr + pagesize;
265 Job.Progress.Value := radr - minadr;
266 end;
267 Log(SProgramOK);
268 LedOff;
269 Exit;
270 end;
271
272 for radr := minadr to maxadr do
273 begin
274 if flashbuffer[radr] <> $ff then
275 begin
276 b := flashbuffer[radr];
277 ISPWriteFlash(radr, b);
278 b1 := ISPReadFlash(radr);
279 if b <> b1 then
280 begin
281 raise Exception.Create(Format(SWriteError, [IntToHex(radr, 8), IntToHex(b, 2), IntToHex(b1, 2)]));
282 //LedOff;
283 //Exit;
284 end;
285 end;
286 Job.Progress.Value := radr - minadr;
287 end;
288 LedOff;
289 Log(SProgramOK);
290end;
291
292procedure TISPProg.Read;
293begin
294 inherited;
295end;
296
297procedure TISPProg.Verify(Job: TJob);
298begin
299 inherited;
300end;
301
302procedure TISPProg.Erase;
303var
304 res:integer;
305{$IFDEF I2C_SUPPORT}
306 buff: array[0..255] of char;
307{$ENDIF}
308begin
309 //StatusBar1.SimpleText:='';
310 //Application.ProcessMessages;
311 Active := True;
312
313 if devicenr = DEVICE_UNKNOWN then
314 begin
315 Log(SCantEraseNotKnownDevice);
316 Exit;
317 end;
318 Log(SWait);
319 LedOn;
320 //Application.ProcessMessages;
321{$IFDEF I2C_SUPPORT}
322 if proctype = PROC_TYPE_I2C_BUS then
323 begin
324 res := isplib_erase_all;
325 LedOff;
326 if res < 0 then
327 begin
328 isplib_error_desc(res, buff, 256);
329 MessageDlgCenter(string(buff), mtError, [mbOK], 0, Self);
330 StatusBar1.SimpleText := SReady;
331 Exit;
332 end;
333 end
334 else
335{$ENDIF}
336 begin
337 res:=ISPErase;
338 LedOff;
339 end;
340 BeginWork;
341 case res of
342 ISP.ERROR_TIMEOUT:
343 raise Exception.Create(SEraseTimeout);
344 ISP.ERROR_PROGRAM,
345 ISP.ERROR_STOP:
346 raise Exception.Create(SEraseError);
347 else
348 Log(SDeviceErased);
349 end;
350end;
351
352procedure TISPProg.Reset;
353begin
354 Active := True;
355
356 WaitMS(100);
357 StrobeOn;
358 RstOn;
359 //ReadResetStatus;
360 //Application.ProcessMessages;
361 WaitMS(100);
362 RstOff;
363 StrobeOff;
364 //ReadResetStatus;
365 EndWork;
366end;
367
368procedure TISPProg.LoadFromRegistry(Root: HKEY; Key: string);
369begin
370 with TRegistryEx.Create do
371 try
372 RootKey := Root;
373 OpenKey(Key + '\ISPProgrammer\ISPprog', True);
374 pinout_num := ReadIntegerWithDefault('pinout_num', 4);
375 pinout.strobe1 := ReadIntegerWithDefault('pinout_strobe1', 4);
376 pinout.strobe2 := ReadIntegerWithDefault('pinout_strobe2', 3);
377 pinout.reset := ReadIntegerWithDefault('pinout_reset', 8);
378 pinout.mosi := ReadIntegerWithDefault('pinout_mosi', 6);
379 pinout.sck := ReadIntegerWithDefault('pinout_sck', 5);
380 pinout.miso := ReadIntegerWithDefault('pinout_miso', 0);
381 pinout.led := ReadIntegerWithDefault('pinout_led', 12);
382 pinout.resetinv := ReadBoolWithDefault('pinout_resetinv', False);
383 lptno := ReadIntegerWithDefault('lptno', 1);
384 BASE := ReadIntegerWithDefault('BASE', 888);
385 tCLK_8252 := ReadIntegerWithDefault('tCLK_8252', 3616);
386 tCLK_AVR := ReadIntegerWithDefault('tCLK_AVR', 90);
387 MCUfreq := ReadIntegerWithDefault('MCUfreq', 11059200);
388 PinoutChanged;
389 finally
390 Free;
391 end;
392end;
393
394procedure TISPProg.SaveToRegistry(Root: HKEY; Key: string);
395begin
396 with TRegistryEx.Create do
397 try
398 RootKey := Root;
399 OpenKey(Key + '\ISPProgrammer\ISPprog', True);
400 WriteInteger('pinout_num', pinout_num);
401 WriteInteger('pinout_strobe1', pinout.strobe1);
402 WriteInteger('pinout_strobe2', pinout.strobe2);
403 WriteInteger('pinout_reset', pinout.reset);
404 WriteInteger('pinout_mosi', pinout.mosi);
405 WriteInteger('pinout_sck', pinout.sck);
406 WriteInteger('pinout_miso', pinout.miso);
407 WriteInteger('pinout_led', pinout.led);
408 WriteBool('pinout_resetinv', pinout.resetinv);
409 WriteInteger('lptno', lptno);
410 WriteInteger('BASE', BASE);
411 WriteInteger('tCLK_8252', tCLK_8252);
412 WriteInteger('tCLK_AVR', tCLK_AVR);
413 WriteInteger('MCUfreq', MCUfreq);
414 finally
415 Free;
416 end;
417end;
418
419procedure TISPProg.BeginWork;
420{$IFDEF I2C_SUPPORT}
421var
422 buff: array[0..255] of char;
423 res: integer;
424{$ENDIF}
425begin
426 if (proctype = PROC_TYPE_DATAFLASH) or (proctype = PROC_TYPE_SERIALFLASH) then
427 begin
428 StrobeOn;
429 ChipselectOff;
430 ClkLo;
431 WaitMS(100);
432 end
433{$IFDEF I2C_SUPPORT}
434 else if proctype = PROC_TYPE_I2C_BUS then
435 begin
436 res:=isplib_begin_work;
437 if res < 0 then
438 begin
439 isplib_error_desc(res, buff, 256);
440 MessageDlgCenter(string(buff), mtError, [mbOK], 0, Self);
441 Exit;
442 end
443 end
444{$ENDIF}
445 else
446 begin
447 StrobeOn;
448 RstOff;
449 ClkLo;
450 WaitMS(100);
451 RstOn;
452 WaitMS(500);
453 ISPEnable;
454 //ReadResetStatus;
455 end;
456 ReadIdentification;
457end;
458
459procedure TISPProg.EndWork;
460begin
461{$IFDEF I2C_SUPPORT}
462 if proctype = PROC_TYPE_I2C_BUS then
463 isplib_end_work;
464{$ENDIF}
465 LedOff;
466 Log(SReady);
467 ChipSignature := '';
468 devicenr:=0;
469 //EnableButtons;
470end;
471
472function TISPProg.ReadIdentification: string;
473var
474{$IFDEF I2C_SUPPORT}
475 buff:array[0..255] of char;
476 res:integer;
477{$ENDIF}
478 n:integer;
479 s:array[0..2] of byte;
480 z:string;
481 label error;
482begin
483 Active := True;
484
485 if proctype = PROC_TYPE_OLD51 then // 89S8252 or 89S53
486 begin
487 flashsize := 12*1024;
488 eepromsize := 2048;
489 usersigsize := 0;
490 ChipSignature := 'AT89Sxx, Flash: up to 12 KB, EEPROM: up to 2 KB';
491 devicenr := DEVICE_AT89Sxx;
492 //working:=true;
493 //EnableButtons;
494 Exit;
495 end;
496
497{$IFDEF I2C_SUPPORT}
498 if proctype = PROC_TYPE_I2C_BUS then
499 begin
500 // scan I2C bus
501 res:=isplib_scan(buff, 256);
502 if res < 0 then
503 begin
504 isplib_error_desc(res, buff, 256);
505 MessageDlgCenter(string(buff), mtError, [mbOK], 0, Self);
506 end
507 else
508 begin
509 // <res> devices found on I2C bus
510 if res = 0 then
511 z:='No devices'
512 else if res = 1 then
513 z:='1 device'
514 else
515 z:=IntToStr(res) + ' devices';
516 z:=z + ' found on I2C bus.';
517 if res > 0 then
518 begin
519 z:=z + #13#10 + 'Device address:';
520 for n:=1 to res do
521 z:=z + ' 0x' + IntToHex(byte(buff[n - 1]), 2);
522 end;
523 MessageDlgCenter(z, mtInformation, [mbOK], 0, Self);
524 end;
525 if res <= 0 then
526 goto error;
527 end;
528{$ENDIF}
529
530 if forcedev then
531 begin
532 n := FindName(forcename);
533 if (n >= 0) then
534 begin
535 s[0] := Signatures[n].b0;
536 s[1] := Signatures[n].b1;
537 s[2] := Signatures[n].b2;
538 end
539 end
540 else
541 begin
542 ISPReadSign(@s);
543 n := FindSignature(s[0], s[1], s[2]);
544 end;
545
546{$IFDEF I2C_SUPPORT}
547 if (n >= 0) and (proctype = PROC_TYPE_I2C_BUS) then
548 begin
549 // scan I2C bus
550 res := isplib_scan(buff, 256);
551 if res < 0 then
552 begin
553 isplib_error_desc(res, buff, 256);
554 MessageDlgCenter(string(buff), mtError, [mbOK], 0, Self);
555 n := -1;
556 end
557 else
558 begin
559 // <res> devices found on I2C bus
560 if res = 0 then
561 z := 'No devices'
562 else if res = 1 then
563 z := '1 device'
564 else
565 z := IntToStr(res) + ' devices';
566 z := z + ' found on I2C bus.';
567 if res > 0 then
568 begin
569 z := z + #13#10 + 'Device number address';
570 for n := 1 to res do
571 z := z + #13#10 + IntToStr(n) + ' 0x' + IntToHex(byte(buff[n - 1]), 2);
572 end;
573 MessageDlgCenter(z, mtInformation, [mbOK], 0, Self);
574 n := -1;
575 end;
576 end;
577{$ENDIF}
578
579 if (n >= 0) then
580 with Signatures[n] do
581 begin
582 z := name;
583 if (fsize > 0) then
584 begin
585 if (fsize mod 1048576 = 0) then
586 z := z+', Flash: ' + IntToStr(fsize div 1048576) + ' MB'
587 else
588 z := z + ', Flash: ' + IntToStr(fsize div 1024) + ' KB';
589 end;
590 if (esize > 0) then
591 z := z + ', EEPROM: ' + IntToStr(esize) + ' bytes';
592 if (usigsize > 0) then
593 z := z + ', User Signature: ' + IntToStr(usigsize) + ' bytes';
594 devicenr := n;
595 flashsize := fsize;
596 eepromsize := esize;
597 usersigsize := usigsize;
598 ChipSignature := z;
599 //working:=true;
600 //EnableButtons;
601 Exit;
602 end;
603
604error:
605{$IFDEF I2C_SUPPORT}
606 if proctype = PROC_TYPE_I2C_BUS then
607 ChipSignatureLabel.Caption := ''
608 else
609{$ENDIF}
610 ChipSignature := Format(SNotKnown, [IntToHex(s[0], 2),
611 IntToHex(s[1], 2), IntToHex(s[2], 2)]);
612
613 devicenr := 0;
614 flashsize := 0;
615 eepromsize := 0;
616 usersigsize := 0;
617 //Working := False;
618 //EnableButtons;
619 Result := ChipSignature;
620end;
621
622procedure TISPProg.ResetOff;
623begin
624 RstOff;
625 StrobeOff;
626 //ReadResetStatus;
627 EndWork;
628end;
629
630procedure TISPProg.SetCPUType(AValue: TCPUType);
631begin
632 if AValue = ctAT82S8253 then proctype := PROC_TYPE_S8253
633 else if AValue = ctAT89S52 then proctype := PROC_TYPE_NEW51
634 else proctype := PROC_TYPE_AVR;
635end;
636
637procedure TISPProg.SetActive(AValue: Boolean);
638begin
639 if Active = AValue then Exit;
640 inherited;
641 if AValue then begin
642 BeginWork;
643 end else begin
644 EndWork;
645 end;
646end;
647
648constructor TISPProg.Create;
649begin
650 inherited Create;
651 Capabilities := [ipcErase, ipcWrite, ipcReset];
652 CPUType := ctAT82S8253;
653 InpOut32.LoadLibraries;
654 PortsIO.Init;
655end;
656
657{$ENDIF}
658
659end.
660
Note: See TracBrowser for help on using the repository browser.